Theory AuxLemmas
section ‹Auxiliary lemmas›
theory AuxLemmas imports Main begin
text ‹Lemma concerning maps and ‹@››
lemma map_append_append_maps:
assumes map:"map f xs = ys@zs"
obtains xs' xs'' where "map f xs' = ys" and "map f xs'' = zs" and "xs=xs'@xs''"
by (metis append_eq_conv_conj append_take_drop_id assms drop_map take_map that)
text ‹Lemma concerning splitting of @{term list}s›
lemma path_split_general:
assumes all:"∀zs. xs ≠ ys@zs"
obtains j zs where "xs = (take j ys)@zs" and "j < length ys"
and "∀k > j. ∀zs'. xs ≠ (take k ys)@zs'"
proof(atomize_elim)
from ‹∀zs. xs ≠ ys@zs›
show "∃j zs. xs = take j ys @ zs ∧ j < length ys ∧
(∀k>j. ∀zs'. xs ≠ take k ys @ zs')"
proof(induct ys arbitrary:xs)
case Nil thus ?case by auto
next
case (Cons y' ys')
note IH = ‹⋀xs. ∀zs. xs ≠ ys' @ zs ⟹
∃j zs. xs = take j ys' @ zs ∧ j < length ys' ∧
(∀k. j < k ⟶ (∀zs'. xs ≠ take k ys' @ zs'))›
show ?case
proof(cases xs)
case Nil thus ?thesis by simp
next
case (Cons x' xs')
with ‹∀zs. xs ≠ (y' # ys') @ zs› have "x' ≠ y' ∨ (∀zs. xs' ≠ ys' @ zs)"
by simp
show ?thesis
proof(cases "x' = y'")
case True
with ‹x' ≠ y' ∨ (∀zs. xs' ≠ ys' @ zs)› have "∀zs. xs' ≠ ys' @ zs" by simp
from IH[OF this] have "∃j zs. xs' = take j ys' @ zs ∧ j < length ys' ∧
(∀k. j < k ⟶ (∀zs'. xs' ≠ take k ys' @ zs'))" .
then obtain j zs where "xs' = take j ys' @ zs"
and "j < length ys'"
and all_sub:"∀k. j < k ⟶ (∀zs'. xs' ≠ take k ys' @ zs')"
by blast
from ‹xs' = take j ys' @ zs› True
have "(x'#xs') = take (Suc j) (y' # ys') @ zs"
by simp
from all_sub True have all_imp:"∀k. j < k ⟶
(∀zs'. (x'#xs') ≠ take (Suc k) (y' # ys') @ zs')"
by auto
{ fix l assume "(Suc j) < l"
then obtain k where [simp]:"l = Suc k" by(cases l) auto
with ‹(Suc j) < l› have "j < k" by simp
with all_imp
have "∀zs'. (x'#xs') ≠ take (Suc k) (y' # ys') @ zs'"
by simp
hence "∀zs'. (x'#xs') ≠ take l (y' # ys') @ zs'"
by simp }
with ‹(x'#xs') = take (Suc j) (y' # ys') @ zs› ‹j < length ys'› Cons
show ?thesis by (metis Suc_length_conv less_Suc_eq_0_disj)
next
case False
with Cons have "∀i zs'. i > 0 ⟶ xs ≠ take i (y' # ys') @ zs'"
by auto(case_tac i,auto)
moreover
have "∃zs. xs = take 0 (y' # ys') @ zs" by simp
ultimately show ?thesis by(rule_tac x="0" in exI,auto)
qed
qed
qed
qed
end
Theory BasicDefs
chapter ‹The Framework›
theory BasicDefs imports AuxLemmas begin
text ‹
As slicing is a program analysis that can be completely based on the
information given in the CFG, we want to provide a framework which
allows us to formalize and prove properties of slicing regardless of
the actual programming language. So the starting point for the formalization
is the definition of an abstract CFG, i.e.\ without considering features
specific for certain languages. By doing so we ensure that our framework
is as generic as possible since all proofs hold for every language whose
CFG conforms to this abstract CFG.
Static Slicing analyses a CFG prior to execution. Whereas dynamic
slicing can provide better results for certain inputs (i.e.\ trace and
initial state), static slicing is more conservative but provides
results independent of inputs.
Correctness for static slicing is defined using a weak
simulation between nodes and states when traversing the original and
the sliced graph. The weak simulation property demands that if a
(node,state) tuples $(n_1,s_1)$ simulates $(n_2,s_2)$
and making an observable move in the original graph leads from
$(n_1,s_1)$ to $(n_1',s_1')$, this tuple simulates a
tuple $(n_2,s_2)$ which is the result of making an
observable move in the sliced graph beginning in $(n_2',s_2')$.
›
section ‹Basic Definitions›
fun fun_upds :: "('a ⇒ 'b) ⇒ 'a list ⇒ 'b list ⇒ ('a ⇒ 'b)"
where "fun_upds f [] ys = f"
| "fun_upds f xs [] = f"
| "fun_upds f (x#xs) (y#ys) = (fun_upds f xs ys)(x := y)"
notation fun_upds ("_'(_ /[:=]/ _')")
lemma fun_upds_nth:
"⟦i < length xs; length xs = length ys; distinct xs⟧
⟹ f(xs [:=] ys)(xs!i) = (ys!i)"
proof(induct xs arbitrary:ys i)
case Nil thus ?case by simp
next
case (Cons x' xs')
note IH = ‹⋀ys i. ⟦i < length xs'; length xs' = length ys; distinct xs'⟧
⟹ f(xs' [:=] ys) (xs'!i) = ys!i›
from ‹distinct (x'#xs')› have "distinct xs'" and "x' ∉ set xs'" by simp_all
from ‹length (x'#xs') = length ys› obtain y' ys' where [simp]:"ys = y'#ys'"
and "length xs' = length ys'"
by(cases ys) auto
show ?case
proof(cases i)
case 0 thus ?thesis by simp
next
case (Suc j)
with ‹i < length (x'#xs')› have "j < length xs'" by simp
from IH[OF this ‹length xs' = length ys'› ‹distinct xs'›]
have "f(xs' [:=] ys') (xs'!j) = ys'!j" .
with ‹x' ∉ set xs'› ‹j < length xs'›
have "f((x'#xs') [:=] ys) ((x'#xs')!(Suc j)) = ys!(Suc j)" by fastforce
with Suc show ?thesis by simp
qed
qed
lemma fun_upds_eq:
assumes "V ∈ set xs" and "length xs = length ys" and "distinct xs"
shows "f(xs [:=] ys) V = f'(xs [:=] ys) V"
proof -
from ‹V ∈ set xs› obtain i where "i < length xs" and "xs!i = V"
by(fastforce simp:in_set_conv_nth)
with ‹length xs = length ys› ‹distinct xs›
have "f(xs [:=] ys)(xs!i) = (ys!i)" by -(rule fun_upds_nth)
moreover
from ‹i < length xs› ‹xs!i = V› ‹length xs = length ys› ‹distinct xs›
have "f'(xs [:=] ys)(xs!i) = (ys!i)" by -(rule fun_upds_nth)
ultimately show ?thesis using ‹xs!i = V› by simp
qed
lemma fun_upds_notin:"x ∉ set xs ⟹ f(xs [:=] ys) x = f x"
by(induct xs arbitrary:ys,auto,case_tac ys,auto)
subsection ‹‹distinct_fst››
definition distinct_fst :: "('a × 'b) list ⇒ bool" where
"distinct_fst ≡ distinct ∘ map fst"
lemma distinct_fst_Nil [simp]:
"distinct_fst []"
by(simp add:distinct_fst_def)
lemma distinct_fst_Cons [simp]:
"distinct_fst ((k,x)#kxs) = (distinct_fst kxs ∧ (∀y. (k,y) ∉ set kxs))"
by(auto simp:distinct_fst_def image_def)
lemma distinct_fst_isin_same_fst:
"⟦(x,y) ∈ set xs; (x,y') ∈ set xs; distinct_fst xs⟧
⟹ y = y'"
by(induct xs,auto simp:distinct_fst_def image_def)
subsection‹Edge kinds›
text ‹Every procedure has a unique name, e.g. in object oriented languages
‹pname› refers to class + procedure.›
text ‹A state is a call stack of tuples, which consists of:
\begin{enumerate}
\item data information, i.e.\ a mapping from the local variables in the call
frame to their values, and
\item control flow information, e.g.\ which node called the current procedure.
\end{enumerate}
Update and predicate edges check and manipulate only the data information
of the top call stack element. Call and return edges however may use the data and
control flow information present in the top stack element to state if this edge is
traversable. The call edge additionally has a list of functions to determine what
values the parameters have in a certain call frame and control flow information for
the return. The return edge is concerned with passing the values
of the return parameter values to the underlying stack frame. See the funtions
‹transfer› and ‹pred› in locale ‹CFG›.›
datatype (dead 'var, dead 'val, dead 'ret, dead 'pname) edge_kind =
UpdateEdge "('var ⇀ 'val) ⇒ ('var ⇀ 'val)" ("⇑_")
| PredicateEdge "('var ⇀ 'val) ⇒ bool" ("'(_')⇩√")
| CallEdge "('var ⇀ 'val) × 'ret ⇒ bool" "'ret" "'pname"
"(('var ⇀ 'val) ⇀ 'val) list" ("_:_↪⇘_⇙_" 70)
| ReturnEdge "('var ⇀ 'val) × 'ret ⇒ bool" "'pname"
"('var ⇀ 'val) ⇒ ('var ⇀ 'val) ⇒ ('var ⇀ 'val)" ("_↩⇘_⇙_" 70)
definition intra_kind :: "('var,'val,'ret,'pname) edge_kind ⇒ bool"
where "intra_kind et ≡ (∃f. et = ⇑f) ∨ (∃Q. et = (Q)⇩√)"
lemma edge_kind_cases [case_names Intra Call Return]:
"⟦intra_kind et ⟹ P; ⋀Q r p fs. et = Q:r↪⇘p⇙fs ⟹ P;
⋀Q p f. et = Q↩⇘p⇙f ⟹ P⟧ ⟹ P"
by(cases et,auto simp:intra_kind_def)
end
Theory CFG
section ‹CFG›
theory CFG imports BasicDefs begin
subsection ‹The abstract CFG›
subsubsection ‹Locale fixes and assumptions›
locale CFG =
fixes sourcenode :: "'edge ⇒ 'node"
fixes targetnode :: "'edge ⇒ 'node"
fixes kind :: "'edge ⇒ ('var,'val,'ret,'pname) edge_kind"
fixes valid_edge :: "'edge ⇒ bool"
fixes Entry::"'node" ("'('_Entry'_')")
fixes get_proc::"'node ⇒ 'pname"
fixes get_return_edges::"'edge ⇒ 'edge set"
fixes procs::"('pname × 'var list × 'var list) list"
fixes Main::"'pname"
assumes Entry_target [dest]: "⟦valid_edge a; targetnode a = (_Entry_)⟧ ⟹ False"
and get_proc_Entry:"get_proc (_Entry_) = Main"
and Entry_no_call_source:
"⟦valid_edge a; kind a = Q:r↪⇘p⇙fs; sourcenode a = (_Entry_)⟧ ⟹ False"
and edge_det:
"⟦valid_edge a; valid_edge a'; sourcenode a = sourcenode a';
targetnode a = targetnode a'⟧ ⟹ a = a'"
and Main_no_call_target:"⟦valid_edge a; kind a = Q:r↪⇘Main⇙f⟧ ⟹ False"
and Main_no_return_source:"⟦valid_edge a; kind a = Q'↩⇘Main⇙f'⟧ ⟹ False"
and callee_in_procs:
"⟦valid_edge a; kind a = Q:r↪⇘p⇙fs⟧ ⟹ ∃ins outs. (p,ins,outs) ∈ set procs"
and get_proc_intra:"⟦valid_edge a; intra_kind(kind a)⟧
⟹ get_proc (sourcenode a) = get_proc (targetnode a)"
and get_proc_call:
"⟦valid_edge a; kind a = Q:r↪⇘p⇙fs⟧ ⟹ get_proc (targetnode a) = p"
and get_proc_return:
"⟦valid_edge a; kind a = Q'↩⇘p⇙f'⟧ ⟹ get_proc (sourcenode a) = p"
and call_edges_only:"⟦valid_edge a; kind a = Q:r↪⇘p⇙fs⟧
⟹ ∀a'. valid_edge a' ∧ targetnode a' = targetnode a ⟶
(∃Qx rx fsx. kind a' = Qx:rx↪⇘p⇙fsx)"
and return_edges_only:"⟦valid_edge a; kind a = Q'↩⇘p⇙f'⟧
⟹ ∀a'. valid_edge a' ∧ sourcenode a' = sourcenode a ⟶
(∃Qx fx. kind a' = Qx↩⇘p⇙fx)"
and get_return_edge_call:
"⟦valid_edge a; kind a = Q:r↪⇘p⇙fs⟧ ⟹ get_return_edges a ≠ {}"
and get_return_edges_valid:
"⟦valid_edge a; a' ∈ get_return_edges a⟧ ⟹ valid_edge a'"
and only_call_get_return_edges:
"⟦valid_edge a; a' ∈ get_return_edges a⟧ ⟹ ∃Q r p fs. kind a = Q:r↪⇘p⇙fs"
and call_return_edges:
"⟦valid_edge a; kind a = Q:r↪⇘p⇙fs; a' ∈ get_return_edges a⟧
⟹ ∃Q' f'. kind a' = Q'↩⇘p⇙f'"
and return_needs_call: "⟦valid_edge a; kind a = Q'↩⇘p⇙f'⟧
⟹ ∃!a'. valid_edge a' ∧ (∃Q r fs. kind a' = Q:r↪⇘p⇙fs) ∧ a ∈ get_return_edges a'"
and intra_proc_additional_edge:
"⟦valid_edge a; a' ∈ get_return_edges a⟧
⟹ ∃a''. valid_edge a'' ∧ sourcenode a'' = targetnode a ∧
targetnode a'' = sourcenode a' ∧ kind a'' = (λcf. False)⇩√"
and call_return_node_edge:
"⟦valid_edge a; a' ∈ get_return_edges a⟧
⟹ ∃a''. valid_edge a'' ∧ sourcenode a'' = sourcenode a ∧
targetnode a'' = targetnode a' ∧ kind a'' = (λcf. False)⇩√"
and call_only_one_intra_edge:
"⟦valid_edge a; kind a = Q:r↪⇘p⇙fs⟧
⟹ ∃!a'. valid_edge a' ∧ sourcenode a' = sourcenode a ∧ intra_kind(kind a')"
and return_only_one_intra_edge:
"⟦valid_edge a; kind a = Q'↩⇘p⇙f'⟧
⟹ ∃!a'. valid_edge a' ∧ targetnode a' = targetnode a ∧ intra_kind(kind a')"
and same_proc_call_unique_target:
"⟦valid_edge a; valid_edge a'; kind a = Q⇩1:r⇩1↪⇘p⇙fs⇩1; kind a' = Q⇩2:r⇩2↪⇘p⇙fs⇩2⟧
⟹ targetnode a = targetnode a'"
and unique_callers:"distinct_fst procs"
and distinct_formal_ins:"(p,ins,outs) ∈ set procs ⟹ distinct ins"
and distinct_formal_outs:"(p,ins,outs) ∈ set procs ⟹ distinct outs"
begin
lemma get_proc_get_return_edge:
assumes "valid_edge a" and "a' ∈ get_return_edges a"
shows "get_proc (sourcenode a) = get_proc (targetnode a')"
proof -
from assms obtain ax where "valid_edge ax" and "sourcenode a = sourcenode ax"
and "targetnode a' = targetnode ax" and "intra_kind(kind ax)"
by(auto dest:call_return_node_edge simp:intra_kind_def)
thus ?thesis by(fastforce intro:get_proc_intra)
qed
lemma call_intra_edge_False:
assumes "valid_edge a" and "kind a = Q:r↪⇘p⇙fs" and "valid_edge a'"
and "sourcenode a = sourcenode a'" and "intra_kind(kind a')"
shows "kind a' = (λcf. False)⇩√"
proof -
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› obtain ax where "ax ∈ get_return_edges a"
by(fastforce dest:get_return_edge_call)
with ‹valid_edge a› obtain a'' where "valid_edge a''"
and "sourcenode a'' = sourcenode a" and "kind a'' = (λcf. False)⇩√"
by(fastforce dest:call_return_node_edge)
from ‹kind a'' = (λcf. False)⇩√› have "intra_kind(kind a'')"
by(simp add:intra_kind_def)
with assms ‹valid_edge a''› ‹sourcenode a'' = sourcenode a›
‹kind a'' = (λcf. False)⇩√›
show ?thesis by(fastforce dest:call_only_one_intra_edge)
qed
lemma formal_in_THE:
"⟦valid_edge a; kind a = Q:r↪⇘p⇙fs; (p,ins,outs) ∈ set procs⟧
⟹ (THE ins. ∃outs. (p,ins,outs) ∈ set procs) = ins"
by(fastforce dest:distinct_fst_isin_same_fst intro:unique_callers)
lemma formal_out_THE:
"⟦valid_edge a; kind a = Q↩⇘p⇙f; (p,ins,outs) ∈ set procs⟧
⟹ (THE outs. ∃ins. (p,ins,outs) ∈ set procs) = outs"
by(fastforce dest:distinct_fst_isin_same_fst intro:unique_callers)
subsubsection ‹Transfer and predicate functions›
fun params :: "(('var ⇀ 'val) ⇀ 'val) list ⇒ ('var ⇀ 'val) ⇒ 'val option list"
where "params [] cf = []"
| "params (f#fs) cf = (f cf)#params fs cf"
lemma params_nth:
"i < length fs ⟹ (params fs cf)!i = (fs!i) cf"
by(induct fs arbitrary:i,auto,case_tac i,auto)
lemma [simp]:"length (params fs cf) = length fs"
by(induct fs) auto
fun transfer :: "('var,'val,'ret,'pname) edge_kind ⇒ (('var ⇀ 'val) × 'ret) list ⇒
(('var ⇀ 'val) × 'ret) list"
where "transfer (⇑f) (cf#cfs) = (f (fst cf),snd cf)#cfs"
| "transfer (Q)⇩√ (cf#cfs) = (cf#cfs)"
| "transfer (Q:r↪⇘p⇙fs) (cf#cfs) =
(let ins = THE ins. ∃outs. (p,ins,outs) ∈ set procs in
(Map.empty(ins [:=] params fs (fst cf)),r)#cf#cfs)"
| "transfer (Q↩⇘p⇙f )(cf#cfs) = (case cfs of [] ⇒ []
| cf'#cfs' ⇒ (f (fst cf) (fst cf'),snd cf')#cfs')"
| "transfer et [] = []"
fun transfers :: "('var,'val,'ret,'pname) edge_kind list ⇒ (('var ⇀ 'val) × 'ret) list ⇒
(('var ⇀ 'val) × 'ret) list"
where "transfers [] s = s"
| "transfers (et#ets) s = transfers ets (transfer et s)"
fun pred :: "('var,'val,'ret,'pname) edge_kind ⇒ (('var ⇀ 'val) × 'ret) list ⇒ bool"
where "pred (⇑f) (cf#cfs) = True"
| "pred (Q)⇩√ (cf#cfs) = Q (fst cf)"
| "pred (Q:r↪⇘p⇙fs) (cf#cfs) = Q (fst cf,r)"
| "pred (Q↩⇘p⇙f) (cf#cfs) = (Q cf ∧ cfs ≠ [])"
| "pred et [] = False"
fun preds :: "('var,'val,'ret,'pname) edge_kind list ⇒ (('var ⇀ 'val) × 'ret) list ⇒ bool"
where "preds [] s = True"
| "preds (et#ets) s = (pred et s ∧ preds ets (transfer et s))"
lemma transfers_split:
"(transfers (ets@ets') s) = (transfers ets' (transfers ets s))"
by(induct ets arbitrary:s) auto
lemma preds_split:
"(preds (ets@ets') s) = (preds ets s ∧ preds ets' (transfers ets s))"
by(induct ets arbitrary:s) auto
abbreviation state_val :: "(('var ⇀ 'val) × 'ret) list ⇒ 'var ⇀ 'val"
where "state_val s V ≡ (fst (hd s)) V"
subsubsection ‹‹valid_node››
definition valid_node :: "'node ⇒ bool"
where "valid_node n ≡
(∃a. valid_edge a ∧ (n = sourcenode a ∨ n = targetnode a))"
lemma [simp]: "valid_edge a ⟹ valid_node (sourcenode a)"
by(fastforce simp:valid_node_def)
lemma [simp]: "valid_edge a ⟹ valid_node (targetnode a)"
by(fastforce simp:valid_node_def)
subsection ‹CFG paths›
inductive path :: "'node ⇒ 'edge list ⇒ 'node ⇒ bool"
("_ -_→* _" [51,0,0] 80)
where
empty_path:"valid_node n ⟹ n -[]→* n"
| Cons_path:
"⟦n'' -as→* n'; valid_edge a; sourcenode a = n; targetnode a = n''⟧
⟹ n -a#as→* n'"
lemma path_valid_node:
assumes "n -as→* n'" shows "valid_node n" and "valid_node n'"
using ‹n -as→* n'›
by(induct rule:path.induct,auto)
lemma empty_path_nodes [dest]:"n -[]→* n' ⟹ n = n'"
by(fastforce elim:path.cases)
lemma path_valid_edges:"n -as→* n' ⟹ ∀a ∈ set as. valid_edge a"
by(induct rule:path.induct) auto
lemma path_edge:"valid_edge a ⟹ sourcenode a -[a]→* targetnode a"
by(fastforce intro:Cons_path empty_path)
lemma path_Append:"⟦n -as→* n''; n'' -as'→* n'⟧
⟹ n -as@as'→* n'"
by(induct rule:path.induct,auto intro:Cons_path)
lemma path_split:
assumes "n -as@a#as'→* n'"
shows "n -as→* sourcenode a" and "valid_edge a" and "targetnode a -as'→* n'"
using ‹n -as@a#as'→* n'›
proof(induct as arbitrary:n)
case Nil case 1
thus ?case by(fastforce elim:path.cases intro:empty_path)
next
case Nil case 2
thus ?case by(fastforce elim:path.cases intro:path_edge)
next
case Nil case 3
thus ?case by(fastforce elim:path.cases)
next
case (Cons ax asx)
note IH1 = ‹⋀n. n -asx@a#as'→* n' ⟹ n -asx→* sourcenode a›
note IH2 = ‹⋀n. n -asx@a#as'→* n' ⟹ valid_edge a›
note IH3 = ‹⋀n. n -asx@a#as'→* n' ⟹ targetnode a -as'→* n'›
{ case 1
hence "sourcenode ax = n" and "targetnode ax -asx@a#as'→* n'" and "valid_edge ax"
by(auto elim:path.cases)
from IH1[OF ‹ targetnode ax -asx@a#as'→* n'›]
have "targetnode ax -asx→* sourcenode a" .
with ‹sourcenode ax = n› ‹valid_edge ax› show ?case by(fastforce intro:Cons_path)
next
case 2 hence "targetnode ax -asx@a#as'→* n'" by(auto elim:path.cases)
from IH2[OF this] show ?case .
next
case 3 hence "targetnode ax -asx@a#as'→* n'" by(auto elim:path.cases)
from IH3[OF this] show ?case .
}
qed
lemma path_split_Cons:
assumes "n -as→* n'" and "as ≠ []"
obtains a' as' where "as = a'#as'" and "n = sourcenode a'"
and "valid_edge a'" and "targetnode a' -as'→* n'"
proof(atomize_elim)
from ‹as ≠ []› obtain a' as' where "as = a'#as'" by(cases as) auto
with ‹n -as→* n'› have "n -[]@a'#as'→* n'" by simp
hence "n -[]→* sourcenode a'" and "valid_edge a'" and "targetnode a' -as'→* n'"
by(rule path_split)+
from ‹n -[]→* sourcenode a'› have "n = sourcenode a'" by fast
with ‹as = a'#as'› ‹valid_edge a'› ‹targetnode a' -as'→* n'›
show "∃a' as'. as = a'#as' ∧ n = sourcenode a' ∧ valid_edge a' ∧
targetnode a' -as'→* n'"
by fastforce
qed
lemma path_split_snoc:
assumes "n -as→* n'" and "as ≠ []"
obtains a' as' where "as = as'@[a']" and "n -as'→* sourcenode a'"
and "valid_edge a'" and "n' = targetnode a'"
proof(atomize_elim)
from ‹as ≠ []› obtain a' as' where "as = as'@[a']" by(cases as rule:rev_cases) auto
with ‹n -as→* n'› have "n -as'@a'#[]→* n'" by simp
hence "n -as'→* sourcenode a'" and "valid_edge a'" and "targetnode a' -[]→* n'"
by(rule path_split)+
from ‹targetnode a' -[]→* n'› have "n' = targetnode a'" by fast
with ‹as = as'@[a']› ‹valid_edge a'› ‹n -as'→* sourcenode a'›
show "∃as' a'. as = as'@[a'] ∧ n -as'→* sourcenode a' ∧ valid_edge a' ∧
n' = targetnode a'"
by fastforce
qed
lemma path_split_second:
assumes "n -as@a#as'→* n'" shows "sourcenode a -a#as'→* n'"
proof -
from ‹n -as@a#as'→* n'› have "valid_edge a" and "targetnode a -as'→* n'"
by(auto intro:path_split)
thus ?thesis by(fastforce intro:Cons_path)
qed
lemma path_Entry_Cons:
assumes "(_Entry_) -as→* n'" and "n' ≠ (_Entry_)"
obtains n a where "sourcenode a = (_Entry_)" and "targetnode a = n"
and "n -tl as→* n'" and "valid_edge a" and "a = hd as"
proof(atomize_elim)
from ‹(_Entry_) -as→* n'› ‹n' ≠ (_Entry_)› have "as ≠ []"
by(cases as,auto elim:path.cases)
with ‹(_Entry_) -as→* n'› obtain a' as' where "as = a'#as'"
and "(_Entry_) = sourcenode a'" and "valid_edge a'" and "targetnode a' -as'→* n'"
by(erule path_split_Cons)
thus "∃a n. sourcenode a = (_Entry_) ∧ targetnode a = n ∧ n -tl as→* n' ∧
valid_edge a ∧ a = hd as"
by fastforce
qed
lemma path_det:
"⟦n -as→* n'; n -as→* n''⟧ ⟹ n' = n''"
proof(induct as arbitrary:n)
case Nil thus ?case by(auto elim:path.cases)
next
case (Cons a' as')
note IH = ‹⋀n. ⟦n -as'→* n'; n -as'→* n''⟧ ⟹ n' = n''›
from ‹n -a'#as'→* n'› have "targetnode a' -as'→* n'"
by(fastforce elim:path_split_Cons)
from ‹n -a'#as'→* n''› have "targetnode a' -as'→* n''"
by(fastforce elim:path_split_Cons)
from IH[OF ‹targetnode a' -as'→* n'› this] show ?thesis .
qed
definition
sourcenodes :: "'edge list ⇒ 'node list"
where "sourcenodes xs ≡ map sourcenode xs"
definition
kinds :: "'edge list ⇒ ('var,'val,'ret,'pname) edge_kind list"
where "kinds xs ≡ map kind xs"
definition
targetnodes :: "'edge list ⇒ 'node list"
where "targetnodes xs ≡ map targetnode xs"
lemma path_sourcenode:
"⟦n -as→* n'; as ≠ []⟧ ⟹ hd (sourcenodes as) = n"
by(fastforce elim:path_split_Cons simp:sourcenodes_def)
lemma path_targetnode:
"⟦n -as→* n'; as ≠ []⟧ ⟹ last (targetnodes as) = n'"
by(fastforce elim:path_split_snoc simp:targetnodes_def)
lemma sourcenodes_is_n_Cons_butlast_targetnodes:
"⟦n -as→* n'; as ≠ []⟧ ⟹
sourcenodes as = n#(butlast (targetnodes as))"
proof(induct as arbitrary:n)
case Nil thus ?case by simp
next
case (Cons a' as')
note IH = ‹⋀n. ⟦n -as'→* n'; as' ≠ []⟧
⟹ sourcenodes as' = n#(butlast (targetnodes as'))›
from ‹n -a'#as'→* n'› have "n = sourcenode a'" and "targetnode a' -as'→* n'"
by(auto elim:path_split_Cons)
show ?case
proof(cases "as' = []")
case True
with ‹targetnode a' -as'→* n'› have "targetnode a' = n'" by fast
with True ‹n = sourcenode a'› show ?thesis
by(simp add:sourcenodes_def targetnodes_def)
next
case False
from IH[OF ‹targetnode a' -as'→* n'› this]
have "sourcenodes as' = targetnode a' # butlast (targetnodes as')" .
with ‹n = sourcenode a'› False show ?thesis
by(simp add:sourcenodes_def targetnodes_def)
qed
qed
lemma targetnodes_is_tl_sourcenodes_App_n':
"⟦n -as→* n'; as ≠ []⟧ ⟹
targetnodes as = (tl (sourcenodes as))@[n']"
proof(induct as arbitrary:n' rule:rev_induct)
case Nil thus ?case by simp
next
case (snoc a' as')
note IH = ‹⋀n'. ⟦n -as'→* n'; as' ≠ []⟧
⟹ targetnodes as' = tl (sourcenodes as') @ [n']›
from ‹n -as'@[a']→* n'› have "n -as'→* sourcenode a'" and "n' = targetnode a'"
by(auto elim:path_split_snoc)
show ?case
proof(cases "as' = []")
case True
with ‹n -as'→* sourcenode a'› have "n = sourcenode a'" by fast
with True ‹n' = targetnode a'› show ?thesis
by(simp add:sourcenodes_def targetnodes_def)
next
case False
from IH[OF ‹n -as'→* sourcenode a'› this]
have "targetnodes as' = tl (sourcenodes as')@[sourcenode a']" .
with ‹n' = targetnode a'› False show ?thesis
by(simp add:sourcenodes_def targetnodes_def)
qed
qed
subsubsection ‹Intraprocedural paths›
definition intra_path :: "'node ⇒ 'edge list ⇒ 'node ⇒ bool"
("_ -_→⇩ι* _" [51,0,0] 80)
where "n -as→⇩ι* n' ≡ n -as→* n' ∧ (∀a ∈ set as. intra_kind(kind a))"
lemma intra_path_get_procs:
assumes "n -as→⇩ι* n'" shows "get_proc n = get_proc n'"
proof -
from ‹n -as→⇩ι* n'› have "n -as→* n'" and "∀a ∈ set as. intra_kind(kind a)"
by(simp_all add:intra_path_def)
thus ?thesis
proof(induct as arbitrary:n)
case Nil thus ?case by fastforce
next
case (Cons a' as')
note IH = ‹⋀n. ⟦n -as'→* n'; ∀a∈set as'. intra_kind (kind a)⟧
⟹ get_proc n = get_proc n'›
from ‹∀a∈set (a'#as'). intra_kind (kind a)›
have "intra_kind(kind a')" and "∀a∈set as'. intra_kind (kind a)" by simp_all
from ‹n -a'#as'→* n'› have "sourcenode a' = n" and "valid_edge a'"
and "targetnode a' -as'→* n'" by(auto elim:path.cases)
from IH[OF ‹targetnode a' -as'→* n'› ‹∀a∈set as'. intra_kind (kind a)›]
have "get_proc (targetnode a') = get_proc n'" .
from ‹valid_edge a'› ‹intra_kind(kind a')›
have "get_proc (sourcenode a') = get_proc (targetnode a')"
by(rule get_proc_intra)
with ‹sourcenode a' = n› ‹get_proc (targetnode a') = get_proc n'›
show ?case by simp
qed
qed
lemma intra_path_Append:
"⟦n -as→⇩ι* n''; n'' -as'→⇩ι* n'⟧ ⟹ n -as@as'→⇩ι* n'"
by(fastforce intro:path_Append simp:intra_path_def)
lemma get_proc_get_return_edges:
assumes "valid_edge a" and "a' ∈ get_return_edges a"
shows "get_proc(targetnode a) = get_proc(sourcenode a')"
proof -
from ‹valid_edge a› ‹a' ∈ get_return_edges a›
obtain a'' where "valid_edge a''" and "sourcenode a'' = targetnode a"
and "targetnode a'' = sourcenode a'" and "kind a'' = (λcf. False)⇩√"
by(fastforce dest:intra_proc_additional_edge)
from ‹valid_edge a''› ‹kind a'' = (λcf. False)⇩√›
have "get_proc(sourcenode a'') = get_proc(targetnode a'')"
by(fastforce intro:get_proc_intra simp:intra_kind_def)
with ‹sourcenode a'' = targetnode a› ‹targetnode a'' = sourcenode a'›
show ?thesis by simp
qed
subsubsection ‹Valid paths›
declare conj_cong[fundef_cong]
fun valid_path_aux :: "'edge list ⇒ 'edge list ⇒ bool"
where "valid_path_aux cs [] ⟷ True"
| "valid_path_aux cs (a#as) ⟷
(case (kind a) of Q:r↪⇘p⇙fs ⇒ valid_path_aux (a#cs) as
| Q↩⇘p⇙f ⇒ case cs of [] ⇒ valid_path_aux [] as
| c'#cs' ⇒ a ∈ get_return_edges c' ∧
valid_path_aux cs' as
| _ ⇒ valid_path_aux cs as)"
lemma vpa_induct [consumes 1,case_names vpa_empty vpa_intra vpa_Call vpa_ReturnEmpty
vpa_ReturnCons]:
assumes major: "valid_path_aux xs ys"
and rules: "⋀cs. P cs []"
"⋀cs a as. ⟦intra_kind(kind a); valid_path_aux cs as; P cs as⟧ ⟹ P cs (a#as)"
"⋀cs a as Q r p fs. ⟦kind a = Q:r↪⇘p⇙fs; valid_path_aux (a#cs) as; P (a#cs) as⟧
⟹ P cs (a#as)"
"⋀cs a as Q p f. ⟦kind a = Q↩⇘p⇙f; cs = []; valid_path_aux [] as; P [] as⟧
⟹ P cs (a#as)"
"⋀cs a as Q p f c' cs' . ⟦kind a = Q↩⇘p⇙f; cs = c'#cs'; valid_path_aux cs' as;
a ∈ get_return_edges c'; P cs' as⟧
⟹ P cs (a#as)"
shows "P xs ys"
using major
apply(induct ys arbitrary: xs)
by(auto intro:rules split:edge_kind.split_asm list.split_asm simp:intra_kind_def)
lemma valid_path_aux_intra_path:
"∀a ∈ set as. intra_kind(kind a) ⟹ valid_path_aux cs as"
by(induct as,auto simp:intra_kind_def)
lemma valid_path_aux_callstack_prefix:
"valid_path_aux (cs@cs') as ⟹ valid_path_aux cs as"
proof(induct "cs@cs'" as arbitrary:cs cs' rule:vpa_induct)
case vpa_empty thus ?case by simp
next
case (vpa_intra a as)
hence "valid_path_aux cs as" by simp
with ‹intra_kind (kind a)› show ?case by(cases "kind a",auto simp:intra_kind_def)
next
case (vpa_Call a as Q r p fs cs'' cs')
note IH = ‹⋀xs ys. a#cs''@cs' = xs@ys ⟹ valid_path_aux xs as›
have "a#cs''@cs' = (a#cs'')@cs'" by simp
from IH[OF this] have "valid_path_aux (a#cs'') as" .
with ‹kind a = Q:r↪⇘p⇙fs› show ?case by simp
next
case (vpa_ReturnEmpty a as Q p f cs'' cs')
hence "valid_path_aux cs'' as" by simp
with ‹kind a = Q↩⇘p⇙f› ‹cs''@cs' = []› show ?case by simp
next
case (vpa_ReturnCons a as Q p f c' cs' csx csx')
note IH = ‹⋀xs ys. cs' = xs@ys ⟹ valid_path_aux xs as›
from ‹csx@csx' = c'#cs'›
have "csx = [] ∧ csx' = c'#cs' ∨ (∃zs. csx = c'#zs ∧ zs@csx' = cs')"
by(simp add:append_eq_Cons_conv)
thus ?case
proof
assume "csx = [] ∧ csx' = c'#cs'"
hence "csx = []" and "csx' = c'#cs'" by simp_all
from ‹csx' = c'#cs'› have "cs' = []@tl csx'" by simp
from IH[OF this] have "valid_path_aux [] as" .
with ‹csx = []› ‹kind a = Q↩⇘p⇙f› show ?thesis by simp
next
assume "∃zs. csx = c'#zs ∧ zs@csx' = cs'"
then obtain zs where "csx = c'#zs" and "cs' = zs@csx'" by auto
from IH[OF ‹cs' = zs@csx'›] have "valid_path_aux zs as" .
with ‹csx = c'#zs› ‹kind a = Q↩⇘p⇙f› ‹a ∈ get_return_edges c'›
show ?thesis by simp
qed
qed
fun upd_cs :: "'edge list ⇒ 'edge list ⇒ 'edge list"
where "upd_cs cs [] = cs"
| "upd_cs cs (a#as) =
(case (kind a) of Q:r↪⇘p⇙fs ⇒ upd_cs (a#cs) as
| Q↩⇘p⇙f ⇒ case cs of [] ⇒ upd_cs cs as
| c'#cs' ⇒ upd_cs cs' as
| _ ⇒ upd_cs cs as)"
lemma upd_cs_empty [dest]:
"upd_cs cs [] = [] ⟹ cs = []"
by(cases cs) auto
lemma upd_cs_intra_path:
"∀a ∈ set as. intra_kind(kind a) ⟹ upd_cs cs as = cs"
by(induct as,auto simp:intra_kind_def)
lemma upd_cs_Append:
"⟦upd_cs cs as = cs'; upd_cs cs' as' = cs''⟧ ⟹ upd_cs cs (as@as') = cs''"
by(induct as arbitrary:cs,auto split:edge_kind.split list.split)
lemma upd_cs_empty_split:
assumes "upd_cs cs as = []" and "cs ≠ []" and "as ≠ []"
obtains xs ys where "as = xs@ys" and "xs ≠ []" and "upd_cs cs xs = []"
and "∀xs' ys'. xs = xs'@ys' ∧ ys' ≠ [] ⟶ upd_cs cs xs' ≠ []"
and "upd_cs [] ys = []"
proof(atomize_elim)
from ‹upd_cs cs as = []› ‹cs ≠ []› ‹as ≠ []›
show "∃xs ys. as = xs@ys ∧ xs ≠ [] ∧ upd_cs cs xs = [] ∧
(∀xs' ys'. xs = xs'@ys' ∧ ys' ≠ [] ⟶ upd_cs cs xs' ≠ []) ∧
upd_cs [] ys = []"
proof(induct as arbitrary:cs)
case Nil thus ?case by simp
next
case (Cons a' as')
note IH = ‹⋀cs. ⟦upd_cs cs as' = []; cs ≠ []; as' ≠ []⟧
⟹ ∃xs ys. as' = xs@ys ∧ xs ≠ [] ∧ upd_cs cs xs = [] ∧
(∀xs' ys'. xs = xs'@ys' ∧ ys' ≠ [] ⟶ upd_cs cs xs' ≠ []) ∧
upd_cs [] ys = []›
show ?case
proof(cases "kind a'" rule:edge_kind_cases)
case Intra
with ‹upd_cs cs (a'#as') = []› have "upd_cs cs as' = []"
by(fastforce simp:intra_kind_def)
with ‹cs ≠ []› have "as' ≠ []" by fastforce
from IH[OF ‹upd_cs cs as' = []› ‹cs ≠ []› this] obtain xs ys where "as' = xs@ys"
and "xs ≠ []" and "upd_cs cs xs = []" and "upd_cs [] ys = []"
and "∀xs' ys'. xs = xs'@ys' ∧ ys' ≠ [] ⟶ upd_cs cs xs' ≠ []" by blast
from ‹upd_cs cs xs = []› Intra have "upd_cs cs (a'#xs) = []"
by(fastforce simp:intra_kind_def)
from ‹∀xs' ys'. xs = xs'@ys' ∧ ys' ≠ [] ⟶ upd_cs cs xs' ≠ []› ‹xs ≠ []› Intra
have "∀xs' ys'. a'#xs = xs'@ys' ∧ ys' ≠ [] ⟶ upd_cs cs xs' ≠ []"
apply auto
apply(case_tac xs') apply(auto simp:intra_kind_def)
by(erule_tac x="[]" in allE,fastforce)+
with ‹as' = xs@ys› ‹upd_cs cs (a'#xs) = []› ‹upd_cs [] ys = []›
show ?thesis apply(rule_tac x="a'#xs" in exI) by fastforce
next
case (Call Q p f)
with ‹upd_cs cs (a'#as') = []› have "upd_cs (a'#cs) as' = []" by simp
with ‹cs ≠ []› have "as' ≠ []" by fastforce
from IH[OF ‹upd_cs (a'#cs) as' = []› _ this] obtain xs ys where "as' = xs@ys"
and "xs ≠ []" and "upd_cs (a'#cs) xs = []" and "upd_cs [] ys = []"
and "∀xs' ys'. xs = xs'@ys' ∧ ys' ≠ [] ⟶ upd_cs (a'#cs) xs' ≠ []" by blast
from ‹upd_cs (a'#cs) xs = []› Call have "upd_cs cs (a'#xs) = []" by simp
from ‹∀xs' ys'. xs = xs'@ys' ∧ ys' ≠ [] ⟶ upd_cs (a'#cs) xs' ≠ []›
‹xs ≠ []› ‹cs ≠ []› Call
have "∀xs' ys'. a'#xs = xs'@ys' ∧ ys' ≠ [] ⟶ upd_cs cs xs' ≠ []"
by auto(case_tac xs',auto)
with ‹as' = xs@ys› ‹upd_cs cs (a'#xs) = []› ‹upd_cs [] ys = []›
show ?thesis apply(rule_tac x="a'#xs" in exI) by fastforce
next
case (Return Q p f)
with ‹upd_cs cs (a'#as') = []› ‹cs ≠ []› obtain c' cs' where "cs = c'#cs'"
and "upd_cs cs' as' = []" by(cases cs) auto
show ?thesis
proof(cases "cs' = []")
case True
with ‹cs = c'#cs'› ‹upd_cs cs' as' = []› Return show ?thesis
apply(rule_tac x="[a']" in exI) apply clarsimp
by(case_tac xs') auto
next
case False
with ‹upd_cs cs' as' = []› have "as' ≠ []" by fastforce
from IH[OF ‹upd_cs cs' as' = []› False this] obtain xs ys where "as' = xs@ys"
and "xs ≠ []" and "upd_cs cs' xs = []" and "upd_cs [] ys = []"
and "∀xs' ys'. xs = xs'@ys' ∧ ys' ≠ [] ⟶ upd_cs cs' xs' ≠ []" by blast
from ‹upd_cs cs' xs = []› ‹cs = c'#cs'› Return have "upd_cs cs (a'#xs) = []"
by simp
from ‹∀xs' ys'. xs = xs'@ys' ∧ ys' ≠ [] ⟶ upd_cs cs' xs' ≠ []›
‹xs ≠ []› ‹cs = c'#cs'› Return
have "∀xs' ys'. a'#xs = xs'@ys' ∧ ys' ≠ [] ⟶ upd_cs cs xs' ≠ []"
by auto(case_tac xs',auto)
with ‹as' = xs@ys› ‹upd_cs cs (a'#xs) = []› ‹upd_cs [] ys = []›
show ?thesis apply(rule_tac x="a'#xs" in exI) by fastforce
qed
qed
qed
qed
lemma upd_cs_snoc_Return_Cons:
assumes "kind a = Q↩⇘p⇙f"
shows "upd_cs cs as = c'#cs' ⟹ upd_cs cs (as@[a]) = cs'"
proof(induct as arbitrary:cs)
case Nil
with ‹kind a = Q↩⇘p⇙f› have "upd_cs cs [a] = cs'" by simp
thus ?case by simp
next
case (Cons a' as')
note IH = ‹⋀cs. upd_cs cs as' = c'#cs' ⟹ upd_cs cs (as'@[a]) = cs'›
show ?case
proof(cases "kind a'" rule:edge_kind_cases)
case Intra
with ‹upd_cs cs (a'#as') = c'#cs'›
have "upd_cs cs as' = c'#cs'" by(fastforce simp:intra_kind_def)
from IH[OF this] have "upd_cs cs (as'@[a]) = cs'" .
with Intra show ?thesis by(fastforce simp:intra_kind_def)
next
case Call
with ‹upd_cs cs (a'#as') = c'#cs'›
have "upd_cs (a'#cs) as' = c'#cs'" by simp
from IH[OF this] have "upd_cs (a'#cs) (as'@[a]) = cs'" .
with Call show ?thesis by simp
next
case Return
show ?thesis
proof(cases cs)
case Nil
with ‹upd_cs cs (a'#as') = c'#cs'› Return
have "upd_cs cs as' = c'#cs'" by simp
from IH[OF this] have "upd_cs cs (as'@[a]) = cs'" .
with Nil Return show ?thesis by simp
next
case (Cons cx csx)
with ‹upd_cs cs (a'#as') = c'#cs'› Return
have "upd_cs csx as' = c'#cs'" by simp
from IH[OF this] have "upd_cs csx (as'@[a]) = cs'" .
with Cons Return show ?thesis by simp
qed
qed
qed
lemma upd_cs_snoc_Call:
assumes "kind a = Q:r↪⇘p⇙fs"
shows "upd_cs cs (as@[a]) = a#(upd_cs cs as)"
proof(induct as arbitrary:cs)
case Nil
with ‹kind a = Q:r↪⇘p⇙fs› show ?case by simp
next
case (Cons a' as')
note IH = ‹⋀cs. upd_cs cs (as'@[a]) = a#upd_cs cs as'›
show ?case
proof(cases "kind a'" rule:edge_kind_cases)
case Intra
with IH[of cs] show ?thesis by(fastforce simp:intra_kind_def)
next
case Call
with IH[of "a'#cs"] show ?thesis by simp
next
case Return
show ?thesis
proof(cases cs)
case Nil
with IH[of "[]"] Return show ?thesis by simp
next
case (Cons cx csx)
with IH[of csx] Return show ?thesis by simp
qed
qed
qed
lemma valid_path_aux_split:
assumes "valid_path_aux cs (as@as')"
shows "valid_path_aux cs as" and "valid_path_aux (upd_cs cs as) as'"
using ‹valid_path_aux cs (as@as')›
proof(induct cs "as@as'" arbitrary:as as' rule:vpa_induct)
case (vpa_intra cs a as as'')
note IH1 = ‹⋀xs ys. as = xs@ys ⟹ valid_path_aux cs xs›
note IH2 = ‹⋀xs ys. as = xs@ys ⟹ valid_path_aux (upd_cs cs xs) ys›
{ case 1
from vpa_intra
have "as'' = [] ∧ a#as = as' ∨ (∃xs. a#xs = as'' ∧ as = xs@as')"
by(simp add:Cons_eq_append_conv)
thus ?case
proof
assume "as'' = [] ∧ a#as = as'"
thus ?thesis by simp
next
assume "∃xs. a#xs = as'' ∧ as = xs@as'"
then obtain xs where "a#xs = as''" and "as = xs@as'" by auto
from IH1[OF ‹as = xs@as'›] have "valid_path_aux cs xs" .
with ‹a#xs = as''› ‹intra_kind (kind a)›
show ?thesis by(fastforce simp:intra_kind_def)
qed
next
case 2
from vpa_intra
have "as'' = [] ∧ a#as = as' ∨ (∃xs. a#xs = as'' ∧ as = xs@as')"
by(simp add:Cons_eq_append_conv)
thus ?case
proof
assume "as'' = [] ∧ a#as = as'"
hence "as = []@tl as'" by(cases as') auto
from IH2[OF this] have "valid_path_aux (upd_cs cs []) (tl as')" by simp
with ‹as'' = [] ∧ a#as = as'› ‹intra_kind (kind a)›
show ?thesis by(fastforce simp:intra_kind_def)
next
assume "∃xs. a#xs = as'' ∧ as = xs@as'"
then obtain xs where "a#xs = as''" and "as = xs@as'" by auto
from IH2[OF ‹as = xs@as'›] have "valid_path_aux (upd_cs cs xs) as'" .
from ‹a#xs = as''› ‹intra_kind (kind a)›
have "upd_cs cs xs = upd_cs cs as''" by(fastforce simp:intra_kind_def)
with ‹valid_path_aux (upd_cs cs xs) as'›
show ?thesis by simp
qed
}
next
case (vpa_Call cs a as Q r p fs as'')
note IH1 = ‹⋀xs ys. as = xs@ys ⟹ valid_path_aux (a#cs) xs›
note IH2 = ‹⋀xs ys. as = xs@ys ⟹ valid_path_aux (upd_cs (a#cs) xs) ys›
{ case 1
from vpa_Call
have "as'' = [] ∧ a#as = as' ∨ (∃xs. a#xs = as'' ∧ as = xs@as')"
by(simp add:Cons_eq_append_conv)
thus ?case
proof
assume "as'' = [] ∧ a#as = as'"
thus ?thesis by simp
next
assume "∃xs. a#xs = as'' ∧ as = xs@as'"
then obtain xs where "a#xs = as''" and "as = xs@as'" by auto
from IH1[OF ‹as = xs@as'›] have "valid_path_aux (a#cs) xs" .
with ‹a#xs = as''›[THEN sym] ‹kind a = Q:r↪⇘p⇙fs›
show ?thesis by simp
qed
next
case 2
from vpa_Call
have "as'' = [] ∧ a#as = as' ∨ (∃xs. a#xs = as'' ∧ as = xs@as')"
by(simp add:Cons_eq_append_conv)
thus ?case
proof
assume "as'' = [] ∧ a#as = as'"
hence "as = []@tl as'" by(cases as') auto
from IH2[OF this] have "valid_path_aux (upd_cs (a#cs) []) (tl as')" .
with ‹as'' = [] ∧ a#as = as'› ‹kind a = Q:r↪⇘p⇙fs›
show ?thesis by clarsimp
next
assume "∃xs. a#xs = as'' ∧ as = xs@as'"
then obtain xs where "a#xs = as''" and "as = xs@as'" by auto
from IH2[OF ‹as = xs@as'›] have "valid_path_aux (upd_cs (a # cs) xs) as'" .
with ‹a#xs = as''›[THEN sym] ‹kind a = Q:r↪⇘p⇙fs›
show ?thesis by simp
qed
}
next
case (vpa_ReturnEmpty cs a as Q p f as'')
note IH1 = ‹⋀xs ys. as = xs@ys ⟹ valid_path_aux [] xs›
note IH2 = ‹⋀xs ys. as = xs@ys ⟹ valid_path_aux (upd_cs [] xs) ys›
{ case 1
from vpa_ReturnEmpty
have "as'' = [] ∧ a#as = as' ∨ (∃xs. a#xs = as'' ∧ as = xs@as')"
by(simp add:Cons_eq_append_conv)
thus ?case
proof
assume "as'' = [] ∧ a#as = as'"
thus ?thesis by simp
next
assume "∃xs. a#xs = as'' ∧ as = xs@as'"
then obtain xs where "a#xs = as''" and "as = xs@as'" by auto
from IH1[OF ‹as = xs@as'›] have "valid_path_aux [] xs" .
with ‹a#xs = as''›[THEN sym] ‹kind a = Q↩⇘p⇙f› ‹cs = []›
show ?thesis by simp
qed
next
case 2
from vpa_ReturnEmpty
have "as'' = [] ∧ a#as = as' ∨ (∃xs. a#xs = as'' ∧ as = xs@as')"
by(simp add:Cons_eq_append_conv)
thus ?case
proof
assume "as'' = [] ∧ a#as = as'"
hence "as = []@tl as'" by(cases as') auto
from IH2[OF this] have "valid_path_aux [] (tl as')" by simp
with ‹as'' = [] ∧ a#as = as'› ‹kind a = Q↩⇘p⇙f› ‹cs = []›
show ?thesis by fastforce
next
assume "∃xs. a#xs = as'' ∧ as = xs@as'"
then obtain xs where "a#xs = as''" and "as = xs@as'" by auto
from IH2[OF ‹as = xs@as'›] have "valid_path_aux (upd_cs [] xs) as'" .
from ‹a#xs = as''›[THEN sym] ‹kind a = Q↩⇘p⇙f› ‹cs = []›
have "upd_cs [] xs = upd_cs cs as''" by simp
with ‹valid_path_aux (upd_cs [] xs) as'› show ?thesis by simp
qed
}
next
case (vpa_ReturnCons cs a as Q p f c' cs' as'')
note IH1 = ‹⋀xs ys. as = xs@ys ⟹ valid_path_aux cs' xs›
note IH2 = ‹⋀xs ys. as = xs@ys ⟹ valid_path_aux (upd_cs cs' xs) ys›
{ case 1
from vpa_ReturnCons
have "as'' = [] ∧ a#as = as' ∨ (∃xs. a#xs = as'' ∧ as = xs@as')"
by(simp add:Cons_eq_append_conv)
thus ?case
proof
assume "as'' = [] ∧ a#as = as'"
thus ?thesis by simp
next
assume "∃xs. a#xs = as'' ∧ as = xs@as'"
then obtain xs where "a#xs = as''" and "as = xs@as'" by auto
from IH1[OF ‹as = xs@as'›] have "valid_path_aux cs' xs" .
with ‹a#xs = as''›[THEN sym] ‹kind a = Q↩⇘p⇙f› ‹cs = c'#cs'›
‹a ∈ get_return_edges c'›
show ?thesis by simp
qed
next
case 2
from vpa_ReturnCons
have "as'' = [] ∧ a#as = as' ∨ (∃xs. a#xs = as'' ∧ as = xs@as')"
by(simp add:Cons_eq_append_conv)
thus ?case
proof
assume "as'' = [] ∧ a#as = as'"
hence "as = []@tl as'" by(cases as') auto
from IH2[OF this] have "valid_path_aux (upd_cs cs' []) (tl as')" .
with ‹as'' = [] ∧ a#as = as'› ‹kind a = Q↩⇘p⇙f› ‹cs = c'#cs'›
‹a ∈ get_return_edges c'›
show ?thesis by fastforce
next
assume "∃xs. a#xs = as'' ∧ as = xs@as'"
then obtain xs where "a#xs = as''" and "as = xs@as'" by auto
from IH2[OF ‹as = xs@as'›] have "valid_path_aux (upd_cs cs' xs) as'" .
from ‹a#xs = as''›[THEN sym] ‹kind a = Q↩⇘p⇙f› ‹cs = c'#cs'›
have "upd_cs cs' xs = upd_cs cs as''" by simp
with ‹valid_path_aux (upd_cs cs' xs) as'› show ?thesis by simp
qed
}
qed simp_all
lemma valid_path_aux_Append:
"⟦valid_path_aux cs as; valid_path_aux (upd_cs cs as) as'⟧
⟹ valid_path_aux cs (as@as')"
by(induct rule:vpa_induct,auto simp:intra_kind_def)
lemma vpa_snoc_Call:
assumes "kind a = Q:r↪⇘p⇙fs"
shows "valid_path_aux cs as ⟹ valid_path_aux cs (as@[a])"
proof(induct rule:vpa_induct)
case (vpa_empty cs)
from ‹kind a = Q:r↪⇘p⇙fs› have "valid_path_aux cs [a]" by simp
thus ?case by simp
next
case (vpa_intra cs a' as')
from ‹valid_path_aux cs (as'@[a])› ‹intra_kind (kind a')›
have "valid_path_aux cs (a'#(as'@[a]))"
by(fastforce simp:intra_kind_def)
thus ?case by simp
next
case (vpa_Call cs a' as' Q' r' p' fs')
from ‹valid_path_aux (a'#cs) (as'@[a])› ‹kind a' = Q':r'↪⇘p'⇙fs'›
have "valid_path_aux cs (a'#(as'@[a]))" by simp
thus ?case by simp
next
case (vpa_ReturnEmpty cs a' as' Q' p' f')
from ‹valid_path_aux [] (as'@[a])› ‹kind a' = Q'↩⇘p'⇙f'› ‹cs = []›
have "valid_path_aux cs (a'#(as'@[a]))" by simp
thus ?case by simp
next
case (vpa_ReturnCons cs a' as' Q' p' f' c' cs')
from ‹valid_path_aux cs' (as'@[a])› ‹kind a' = Q'↩⇘p'⇙f'› ‹cs = c'#cs'›
‹a' ∈ get_return_edges c'›
have "valid_path_aux cs (a'#(as'@[a]))" by simp
thus ?case by simp
qed
definition valid_path :: "'edge list ⇒ bool"
where "valid_path as ≡ valid_path_aux [] as"
lemma valid_path_aux_valid_path:
"valid_path_aux cs as ⟹ valid_path as"
by(fastforce intro:valid_path_aux_callstack_prefix simp:valid_path_def)
lemma valid_path_split:
assumes "valid_path (as@as')" shows "valid_path as" and "valid_path as'"
using ‹valid_path (as@as')›
apply(auto simp:valid_path_def)
apply(erule valid_path_aux_split)
apply(drule valid_path_aux_split(2))
by(fastforce intro:valid_path_aux_callstack_prefix)
definition valid_path' :: "'node ⇒ 'edge list ⇒ 'node ⇒ bool"
("_ -_→⇩√* _" [51,0,0] 80)
where vp_def:"n -as→⇩√* n' ≡ n -as→* n' ∧ valid_path as"
lemma intra_path_vp:
assumes "n -as→⇩ι* n'" shows "n -as→⇩√* n'"
proof -
from ‹n -as→⇩ι* n'› have "n -as→* n'" and "∀a ∈ set as. intra_kind(kind a)"
by(simp_all add:intra_path_def)
from ‹∀a ∈ set as. intra_kind(kind a)› have "valid_path_aux [] as"
by(rule valid_path_aux_intra_path)
thus ?thesis using ‹n -as→* n'› by(simp add:vp_def valid_path_def)
qed
lemma vp_split_Cons:
assumes "n -as→⇩√* n'" and "as ≠ []"
obtains a' as' where "as = a'#as'" and "n = sourcenode a'"
and "valid_edge a'" and "targetnode a' -as'→⇩√* n'"
proof(atomize_elim)
from ‹n -as→⇩√* n'› ‹as ≠ []› obtain a' as' where "as = a'#as'"
and "n = sourcenode a'" and "valid_edge a'" and "targetnode a' -as'→* n'"
by(fastforce elim:path_split_Cons simp:vp_def)
from ‹n -as→⇩√* n'› have "valid_path as" by(simp add:vp_def)
from ‹as = a'#as'› have "as = [a']@as'" by simp
with ‹valid_path as› have "valid_path ([a']@as')" by simp
hence "valid_path as'" by(rule valid_path_split)
with ‹targetnode a' -as'→* n'› have "targetnode a' -as'→⇩√* n'" by(simp add:vp_def)
with ‹as = a'#as'› ‹n = sourcenode a'› ‹valid_edge a'›
show "∃a' as'. as = a'#as' ∧ n = sourcenode a' ∧ valid_edge a' ∧
targetnode a' -as'→⇩√* n'" by blast
qed
lemma vp_split_snoc:
assumes "n -as→⇩√* n'" and "as ≠ []"
obtains a' as' where "as = as'@[a']" and "n -as'→⇩√* sourcenode a'"
and "valid_edge a'" and "n' = targetnode a'"
proof(atomize_elim)
from ‹n -as→⇩√* n'› ‹as ≠ []› obtain a' as' where "as = as'@[a']"
and "n -as'→* sourcenode a'" and "valid_edge a'" and "n' = targetnode a'"
by(clarsimp simp:vp_def)(erule path_split_snoc,auto)
from ‹n -as→⇩√* n'› ‹as = as'@[a']› have "valid_path (as'@[a'])" by(simp add:vp_def)
hence "valid_path as'" by(rule valid_path_split)
with ‹n -as'→* sourcenode a'› have "n -as'→⇩√* sourcenode a'" by(simp add:vp_def)
with ‹as = as'@[a']› ‹valid_edge a'› ‹n' = targetnode a'›
show "∃as' a'. as = as'@[a'] ∧ n -as'→⇩√* sourcenode a' ∧ valid_edge a' ∧
n' = targetnode a'"
by blast
qed
lemma vp_split:
assumes "n -as@a#as'→⇩√* n'"
shows "n -as→⇩√* sourcenode a" and "valid_edge a" and "targetnode a -as'→⇩√* n'"
proof -
from ‹n -as@a#as'→⇩√* n'› have "n -as→* sourcenode a" and "valid_edge a"
and "targetnode a -as'→* n'"
by(auto intro:path_split simp:vp_def)
from ‹n -as@a#as'→⇩√* n'› have "valid_path (as@a#as')" by(simp add:vp_def)
hence "valid_path as" and "valid_path (a#as')" by(auto intro:valid_path_split)
from ‹valid_path (a#as')› have "valid_path ([a]@as')" by simp
hence "valid_path as'" by(rule valid_path_split)
with ‹n -as→* sourcenode a› ‹valid_path as› ‹valid_edge a› ‹targetnode a -as'→* n'›
show "n -as→⇩√* sourcenode a" "valid_edge a" "targetnode a -as'→⇩√* n'"
by(auto simp:vp_def)
qed
lemma vp_split_second:
assumes "n -as@a#as'→⇩√* n'" shows "sourcenode a -a#as'→⇩√* n'"
proof -
from ‹n -as@a#as'→⇩√* n'› have "sourcenode a -a#as'→* n'"
by(fastforce elim:path_split_second simp:vp_def)
from ‹n -as@a#as'→⇩√* n'› have "valid_path (as@a#as')" by(simp add:vp_def)
hence "valid_path (a#as')" by(rule valid_path_split)
with ‹sourcenode a -a#as'→* n'› show ?thesis by(simp add:vp_def)
qed
function valid_path_rev_aux :: "'edge list ⇒ 'edge list ⇒ bool"
where "valid_path_rev_aux cs [] ⟷ True"
| "valid_path_rev_aux cs (as@[a]) ⟷
(case (kind a) of Q↩⇘p⇙f ⇒ valid_path_rev_aux (a#cs) as
| Q:r↪⇘p⇙fs ⇒ case cs of [] ⇒ valid_path_rev_aux [] as
| c'#cs' ⇒ c' ∈ get_return_edges a ∧
valid_path_rev_aux cs' as
| _ ⇒ valid_path_rev_aux cs as)"
by auto(case_tac b rule:rev_cases,auto)
termination by lexicographic_order
lemma vpra_induct [consumes 1,case_names vpra_empty vpra_intra vpra_Return
vpra_CallEmpty vpra_CallCons]:
assumes major: "valid_path_rev_aux xs ys"
and rules: "⋀cs. P cs []"
"⋀cs a as. ⟦intra_kind(kind a); valid_path_rev_aux cs as; P cs as⟧
⟹ P cs (as@[a])"
"⋀cs a as Q p f. ⟦kind a = Q↩⇘p⇙f; valid_path_rev_aux (a#cs) as; P (a#cs) as⟧
⟹ P cs (as@[a])"
"⋀cs a as Q r p fs. ⟦kind a = Q:r↪⇘p⇙fs; cs = []; valid_path_rev_aux [] as;
P [] as⟧ ⟹ P cs (as@[a])"
"⋀cs a as Q r p fs c' cs'. ⟦kind a = Q:r↪⇘p⇙fs; cs = c'#cs';
valid_path_rev_aux cs' as; c' ∈ get_return_edges a; P cs' as⟧
⟹ P cs (as@[a])"
shows "P xs ys"
using major
apply(induct ys arbitrary:xs rule:rev_induct)
by(auto intro:rules split:edge_kind.split_asm list.split_asm simp:intra_kind_def)
lemma vpra_callstack_prefix:
"valid_path_rev_aux (cs@cs') as ⟹ valid_path_rev_aux cs as"
proof(induct "cs@cs'" as arbitrary:cs cs' rule:vpra_induct)
case vpra_empty thus ?case by simp
next
case (vpra_intra a as)
hence "valid_path_rev_aux cs as" by simp
with ‹intra_kind (kind a)› show ?case by(fastforce simp:intra_kind_def)
next
case (vpra_Return a as Q p f)
note IH = ‹⋀ds ds'. a#cs@cs' = ds@ds' ⟹ valid_path_rev_aux ds as›
have "a#cs@cs' = (a#cs)@cs'" by simp
from IH[OF this] have "valid_path_rev_aux (a#cs) as" .
with ‹kind a = Q↩⇘p⇙f› show ?case by simp
next
case (vpra_CallEmpty a as Q r p fs)
hence "valid_path_rev_aux cs as" by simp
with ‹kind a = Q:r↪⇘p⇙fs› ‹cs@cs' = []› show ?case by simp
next
case (vpra_CallCons a as Q r p fs c' csx)
note IH = ‹⋀cs cs'. csx = cs@cs' ⟹ valid_path_rev_aux cs as›
from ‹cs@cs' = c'#csx›
have "(cs = [] ∧ cs' = c'#csx) ∨ (∃zs. cs = c'#zs ∧ zs@cs' = csx)"
by(simp add:append_eq_Cons_conv)
thus ?case
proof
assume "cs = [] ∧ cs' = c'#csx"
hence "cs = []" and "cs' = c'#csx" by simp_all
from ‹cs' = c'#csx› have "csx = []@tl cs'" by simp
from IH[OF this] have "valid_path_rev_aux [] as" .
with ‹cs = []› ‹kind a = Q:r↪⇘p⇙fs› show ?thesis by simp
next
assume "∃zs. cs = c'#zs ∧ zs@cs' = csx"
then obtain zs where "cs = c'#zs" and "csx = zs@cs'" by auto
from IH[OF ‹csx = zs@cs'›] have "valid_path_rev_aux zs as" .
with ‹cs = c'#zs› ‹kind a = Q:r↪⇘p⇙fs› ‹c' ∈ get_return_edges a› show ?thesis by simp
qed
qed
function upd_rev_cs :: "'edge list ⇒ 'edge list ⇒ 'edge list"
where "upd_rev_cs cs [] = cs"
| "upd_rev_cs cs (as@[a]) =
(case (kind a) of Q↩⇘p⇙f ⇒ upd_rev_cs (a#cs) as
| Q:r↪⇘p⇙fs ⇒ case cs of [] ⇒ upd_rev_cs cs as
| c'#cs' ⇒ upd_rev_cs cs' as
| _ ⇒ upd_rev_cs cs as)"
by auto(case_tac b rule:rev_cases,auto)
termination by lexicographic_order
lemma upd_rev_cs_empty [dest]:
"upd_rev_cs cs [] = [] ⟹ cs = []"
by(cases cs) auto
lemma valid_path_rev_aux_split:
assumes "valid_path_rev_aux cs (as@as')"
shows "valid_path_rev_aux cs as'" and "valid_path_rev_aux (upd_rev_cs cs as') as"
using ‹valid_path_rev_aux cs (as@as')›
proof(induct cs "as@as'" arbitrary:as as' rule:vpra_induct)
case (vpra_intra cs a as as'')
note IH1 = ‹⋀xs ys. as = xs@ys ⟹ valid_path_rev_aux cs ys›
note IH2 = ‹⋀xs ys. as = xs@ys ⟹ valid_path_rev_aux (upd_rev_cs cs ys) xs›
{ case 1
from vpra_intra
have "as' = [] ∧ as@[a] = as'' ∨ (∃xs. as = as''@xs ∧ xs@[a] = as')"
by(cases as' rule:rev_cases) auto
thus ?case
proof
assume "as' = [] ∧ as@[a] = as''"
thus ?thesis by simp
next
assume "∃xs. as = as''@xs ∧ xs@[a] = as'"
then obtain xs where "as = as''@xs" and "xs@[a] = as'" by auto
from IH1[OF ‹as = as''@xs›] have "valid_path_rev_aux cs xs" .
with ‹xs@[a] = as'› ‹intra_kind (kind a)›
show ?thesis by(fastforce simp:intra_kind_def)
qed
next
case 2
from vpra_intra
have "as' = [] ∧ as@[a] = as'' ∨ (∃xs. as = as''@xs ∧ xs@[a] = as')"
by(cases as' rule:rev_cases) auto
thus ?case
proof
assume "as' = [] ∧ as@[a] = as''"
hence "as = butlast as''@[]" by(cases as) auto
from IH2[OF this] have "valid_path_rev_aux (upd_rev_cs cs []) (butlast as'')" .
with ‹as' = [] ∧ as@[a] = as''› ‹intra_kind (kind a)›
show ?thesis by(fastforce simp:intra_kind_def)
next
assume "∃xs. as = as''@xs ∧ xs@[a] = as'"
then obtain xs where "as = as''@xs" and "xs@[a] = as'" by auto
from IH2[OF ‹as = as''@xs›] have "valid_path_rev_aux (upd_rev_cs cs xs) as''" .
from ‹xs@[a] = as'› ‹intra_kind (kind a)›
have "upd_rev_cs cs xs = upd_rev_cs cs as'" by(fastforce simp:intra_kind_def)
with ‹valid_path_rev_aux (upd_rev_cs cs xs) as''›
show ?thesis by simp
qed
}
next
case (vpra_Return cs a as Q p f as'')
note IH1 = ‹⋀xs ys. as = xs@ys ⟹ valid_path_rev_aux (a#cs) ys›
note IH2 = ‹⋀xs ys. as = xs@ys ⟹ valid_path_rev_aux (upd_rev_cs (a#cs) ys) xs›
{ case 1
from vpra_Return
have "as' = [] ∧ as@[a] = as'' ∨ (∃xs. as = as''@xs ∧ xs@[a] = as')"
by(cases as' rule:rev_cases) auto
thus ?case
proof
assume "as' = [] ∧ as@[a] = as''"
thus ?thesis by simp
next
assume "∃xs. as = as''@xs ∧ xs@[a] = as'"
then obtain xs where "as = as''@xs" and "xs@[a] = as'" by auto
from IH1[OF ‹as = as''@xs›] have "valid_path_rev_aux (a#cs) xs" .
with ‹xs@[a] = as'› ‹kind a = Q↩⇘p⇙f›
show ?thesis by fastforce
qed
next
case 2
from vpra_Return
have "as' = [] ∧ as@[a] = as'' ∨ (∃xs. as = as''@xs ∧ xs@[a] = as')"
by(cases as' rule:rev_cases) auto
thus ?case
proof
assume "as' = [] ∧ as@[a] = as''"
hence "as = butlast as''@[]" by(cases as) auto
from IH2[OF this]
have "valid_path_rev_aux (upd_rev_cs (a#cs) []) (butlast as'')" .
with ‹as' = [] ∧ as@[a] = as''› ‹kind a = Q↩⇘p⇙f›
show ?thesis by fastforce
next
assume "∃xs. as = as''@xs ∧ xs@[a] = as'"
then obtain xs where "as = as''@xs" and "xs@[a] = as'" by auto
from IH2[OF ‹as = as''@xs›]
have "valid_path_rev_aux (upd_rev_cs (a#cs) xs) as''" .
from ‹xs@[a] = as'› ‹kind a = Q↩⇘p⇙f›
have "upd_rev_cs (a#cs) xs = upd_rev_cs cs as'" by fastforce
with ‹valid_path_rev_aux (upd_rev_cs (a#cs) xs) as''›
show ?thesis by simp
qed
}
next
case (vpra_CallEmpty cs a as Q r p fs as'')
note IH1 = ‹⋀xs ys. as = xs@ys ⟹ valid_path_rev_aux [] ys›
note IH2 = ‹⋀xs ys. as = xs@ys ⟹ valid_path_rev_aux (upd_rev_cs [] ys) xs›
{ case 1
from vpra_CallEmpty
have "as' = [] ∧ as@[a] = as'' ∨ (∃xs. as = as''@xs ∧ xs@[a] = as')"
by(cases as' rule:rev_cases) auto
thus ?case
proof
assume "as' = [] ∧ as@[a] = as''"
thus ?thesis by simp
next
assume "∃xs. as = as''@xs ∧ xs@[a] = as'"
then obtain xs where "as = as''@xs" and "xs@[a] = as'" by auto
from IH1[OF ‹as = as''@xs›] have "valid_path_rev_aux [] xs" .
with ‹xs@[a] = as'› ‹kind a = Q:r↪⇘p⇙fs› ‹cs = []›
show ?thesis by fastforce
qed
next
case 2
from vpra_CallEmpty
have "as' = [] ∧ as@[a] = as'' ∨ (∃xs. as = as''@xs ∧ xs@[a] = as')"
by(cases as' rule:rev_cases) auto
thus ?case
proof
assume "as' = [] ∧ as@[a] = as''"
hence "as = butlast as''@[]" by(cases as) auto
from IH2[OF this]
have "valid_path_rev_aux (upd_rev_cs [] []) (butlast as'')" .
with ‹as' = [] ∧ as@[a] = as''› ‹kind a = Q:r↪⇘p⇙fs› ‹cs = []›
show ?thesis by fastforce
next
assume "∃xs. as = as''@xs ∧ xs@[a] = as'"
then obtain xs where "as = as''@xs" and "xs@[a] = as'" by auto
from IH2[OF ‹as = as''@xs›]
have "valid_path_rev_aux (upd_rev_cs [] xs) as''" .
with ‹xs@[a] = as'› ‹kind a = Q:r↪⇘p⇙fs› ‹cs = []›
show ?thesis by fastforce
qed
}
next
case (vpra_CallCons cs a as Q r p fs c' cs' as'')
note IH1 = ‹⋀xs ys. as = xs@ys ⟹ valid_path_rev_aux cs' ys›
note IH2 = ‹⋀xs ys. as = xs@ys ⟹ valid_path_rev_aux (upd_rev_cs cs' ys) xs›
{ case 1
from vpra_CallCons
have "as' = [] ∧ as@[a] = as'' ∨ (∃xs. as = as''@xs ∧ xs@[a] = as')"
by(cases as' rule:rev_cases) auto
thus ?case
proof
assume "as' = [] ∧ as@[a] = as''"
thus ?thesis by simp
next
assume "∃xs. as = as''@xs ∧ xs@[a] = as'"
then obtain xs where "as = as''@xs" and "xs@[a] = as'" by auto
from IH1[OF ‹as = as''@xs›] have "valid_path_rev_aux cs' xs" .
with ‹xs@[a] = as'› ‹kind a = Q:r↪⇘p⇙fs› ‹cs = c' # cs'› ‹c' ∈ get_return_edges a›
show ?thesis by fastforce
qed
next
case 2
from vpra_CallCons
have "as' = [] ∧ as@[a] = as'' ∨ (∃xs. as = as''@xs ∧ xs@[a] = as')"
by(cases as' rule:rev_cases) auto
thus ?case
proof
assume "as' = [] ∧ as@[a] = as''"
hence "as = butlast as''@[]" by(cases as) auto
from IH2[OF this]
have "valid_path_rev_aux (upd_rev_cs cs' []) (butlast as'')" .
with ‹as' = [] ∧ as@[a] = as''› ‹kind a = Q:r↪⇘p⇙fs› ‹cs = c' # cs'›
‹c' ∈ get_return_edges a› show ?thesis by fastforce
next
assume "∃xs. as = as''@xs ∧ xs@[a] = as'"
then obtain xs where "as = as''@xs" and "xs@[a] = as'" by auto
from IH2[OF ‹as = as''@xs›]
have "valid_path_rev_aux (upd_rev_cs cs' xs) as''" .
with ‹xs@[a] = as'› ‹kind a = Q:r↪⇘p⇙fs› ‹cs = c' # cs'›
‹c' ∈ get_return_edges a›
show ?thesis by fastforce
qed
}
qed simp_all
lemma valid_path_rev_aux_Append:
"⟦valid_path_rev_aux cs as'; valid_path_rev_aux (upd_rev_cs cs as') as⟧
⟹ valid_path_rev_aux cs (as@as')"
by(induct rule:vpra_induct,
auto simp:intra_kind_def simp del:append_assoc simp:append_assoc[THEN sym])
lemma vpra_Cons_intra:
assumes "intra_kind(kind a)"
shows "valid_path_rev_aux cs as ⟹ valid_path_rev_aux cs (a#as)"
proof(induct rule:vpra_induct)
case (vpra_empty cs)
have "valid_path_rev_aux cs []" by simp
with ‹intra_kind(kind a)› have "valid_path_rev_aux cs ([]@[a])"
by(simp only:valid_path_rev_aux.simps intra_kind_def,fastforce)
thus ?case by simp
qed(simp only:append_Cons[THEN sym] valid_path_rev_aux.simps intra_kind_def,fastforce)+
lemma vpra_Cons_Return:
assumes "kind a = Q↩⇘p⇙f"
shows "valid_path_rev_aux cs as ⟹ valid_path_rev_aux cs (a#as)"
proof(induct rule:vpra_induct)
case (vpra_empty cs)
from ‹kind a = Q↩⇘p⇙f› have "valid_path_rev_aux cs ([]@[a])"
by(simp only:valid_path_rev_aux.simps,clarsimp)
thus ?case by simp
next
case (vpra_intra cs a' as')
from ‹valid_path_rev_aux cs (a#as')› ‹intra_kind (kind a')›
have "valid_path_rev_aux cs ((a#as')@[a'])"
by(simp only:valid_path_rev_aux.simps,fastforce simp:intra_kind_def)
thus ?case by simp
next
case (vpra_Return cs a' as' Q' p' f')
from ‹valid_path_rev_aux (a'#cs) (a#as')› ‹kind a' = Q'↩⇘p'⇙f'›
have "valid_path_rev_aux cs ((a#as')@[a'])"
by(simp only:valid_path_rev_aux.simps,clarsimp)
thus ?case by simp
next
case (vpra_CallEmpty cs a' as' Q' r' p' fs')
from ‹valid_path_rev_aux [] (a#as')› ‹kind a' = Q':r'↪⇘p'⇙fs'› ‹cs = []›
have "valid_path_rev_aux cs ((a#as')@[a'])"
by(simp only:valid_path_rev_aux.simps,clarsimp)
thus ?case by simp
next
case (vpra_CallCons cs a' as' Q' r' p' fs' c' cs')
from ‹valid_path_rev_aux cs' (a#as')› ‹kind a' = Q':r'↪⇘p'⇙fs'› ‹cs = c'#cs'›
‹c' ∈ get_return_edges a'›
have "valid_path_rev_aux cs ((a#as')@[a'])"
by(simp only:valid_path_rev_aux.simps,clarsimp)
thus ?case by simp
qed
lemmas append_Cons_rev = append_Cons[THEN sym]
declare append_Cons [simp del] append_Cons_rev [simp]
lemma upd_rev_cs_Cons_intra:
assumes "intra_kind(kind a)" shows "upd_rev_cs cs (a#as) = upd_rev_cs cs as"
proof(induct as arbitrary:cs rule:rev_induct)
case Nil
from ‹intra_kind (kind a)›
have "upd_rev_cs cs ([]@[a]) = upd_rev_cs cs []"
by(simp only:upd_rev_cs.simps,auto simp:intra_kind_def)
thus ?case by simp
next
case (snoc a' as')
note IH = ‹⋀cs. upd_rev_cs cs (a#as') = upd_rev_cs cs as'›
show ?case
proof(cases "kind a'" rule:edge_kind_cases)
case Intra
from IH have "upd_rev_cs cs (a#as') = upd_rev_cs cs as'" .
with Intra have "upd_rev_cs cs ((a#as')@[a']) = upd_rev_cs cs (as'@[a'])"
by(fastforce simp:intra_kind_def)
thus ?thesis by simp
next
case Return
from IH have "upd_rev_cs (a'#cs) (a#as') = upd_rev_cs (a'#cs) as'" .
with Return have "upd_rev_cs cs ((a#as')@[a']) = upd_rev_cs cs (as'@[a'])"
by(auto simp:intra_kind_def)
thus ?thesis by simp
next
case Call
show ?thesis
proof(cases cs)
case Nil
from IH have "upd_rev_cs [] (a#as') = upd_rev_cs [] as'" .
with Call Nil have "upd_rev_cs cs ((a#as')@[a']) = upd_rev_cs cs (as'@[a'])"
by(auto simp:intra_kind_def)
thus ?thesis by simp
next
case (Cons c' cs')
from IH have "upd_rev_cs cs' (a#as') = upd_rev_cs cs' as'" .
with Call Cons have "upd_rev_cs cs ((a#as')@[a']) = upd_rev_cs cs (as'@[a'])"
by(auto simp:intra_kind_def)
thus ?thesis by simp
qed
qed
qed
lemma upd_rev_cs_Cons_Return:
assumes "kind a = Q↩⇘p⇙f" shows "upd_rev_cs cs (a#as) = a#(upd_rev_cs cs as)"
proof(induct as arbitrary:cs rule:rev_induct)
case Nil
with ‹kind a = Q↩⇘p⇙f› have "upd_rev_cs cs ([]@[a]) = a#(upd_rev_cs cs [])"
by(simp only:upd_rev_cs.simps) clarsimp
thus ?case by simp
next
case (snoc a' as')
note IH = ‹⋀cs. upd_rev_cs cs (a#as') = a#upd_rev_cs cs as'›
show ?case
proof(cases "kind a'" rule:edge_kind_cases)
case Intra
from IH have "upd_rev_cs cs (a#as') = a#(upd_rev_cs cs as')" .
with Intra have "upd_rev_cs cs ((a#as')@[a']) = a#(upd_rev_cs cs (as'@[a']))"
by(fastforce simp:intra_kind_def)
thus ?thesis by simp
next
case Return
from IH have "upd_rev_cs (a'#cs) (a#as') = a#(upd_rev_cs (a'#cs) as')" .
with Return have "upd_rev_cs cs ((a#as')@[a']) = a#(upd_rev_cs cs (as'@[a']))"
by(auto simp:intra_kind_def)
thus ?thesis by simp
next
case Call
show ?thesis
proof(cases cs)
case Nil
from IH have "upd_rev_cs [] (a#as') = a#(upd_rev_cs [] as')" .
with Call Nil have "upd_rev_cs cs ((a#as')@[a']) = a#(upd_rev_cs cs (as'@[a']))"
by(auto simp:intra_kind_def)
thus ?thesis by simp
next
case (Cons c' cs')
from IH have "upd_rev_cs cs' (a#as') = a#(upd_rev_cs cs' as')" .
with Call Cons
have "upd_rev_cs cs ((a#as')@[a']) = a#(upd_rev_cs cs (as'@[a']))"
by(auto simp:intra_kind_def)
thus ?thesis by simp
qed
qed
qed
lemma upd_rev_cs_Cons_Call_Cons:
assumes "kind a = Q:r↪⇘p⇙fs"
shows "upd_rev_cs cs as = c'#cs' ⟹ upd_rev_cs cs (a#as) = cs'"
proof(induct as arbitrary:cs rule:rev_induct)
case Nil
with ‹kind a = Q:r↪⇘p⇙fs› have "upd_rev_cs cs ([]@[a]) = cs'"
by(simp only:upd_rev_cs.simps) clarsimp
thus ?case by simp
next
case (snoc a' as')
note IH = ‹⋀cs. upd_rev_cs cs as' = c'#cs' ⟹ upd_rev_cs cs (a#as') = cs'›
show ?case
proof(cases "kind a'" rule:edge_kind_cases)
case Intra
with ‹upd_rev_cs cs (as'@[a']) = c'#cs'›
have "upd_rev_cs cs as' = c'#cs'" by(fastforce simp:intra_kind_def)
from IH[OF this] have "upd_rev_cs cs (a#as') = cs'" .
with Intra show ?thesis by(fastforce simp:intra_kind_def)
next
case Return
with ‹upd_rev_cs cs (as'@[a']) = c'#cs'›
have "upd_rev_cs (a'#cs) as' = c'#cs'" by simp
from IH[OF this] have "upd_rev_cs (a'#cs) (a#as') = cs'" .
with Return show ?thesis by simp
next
case Call
show ?thesis
proof(cases cs)
case Nil
with ‹upd_rev_cs cs (as'@[a']) = c'#cs'› Call
have "upd_rev_cs cs as' = c'#cs'" by simp
from IH[OF this] have "upd_rev_cs cs (a#as') = cs'" .
with Nil Call show ?thesis by simp
next
case (Cons cx csx)
with ‹upd_rev_cs cs (as'@[a']) = c'#cs'› Call
have "upd_rev_cs csx as' = c'#cs'" by simp
from IH[OF this] have "upd_rev_cs csx (a#as') = cs'" .
with Cons Call show ?thesis by simp
qed
qed
qed
lemma upd_rev_cs_Cons_Call_Cons_Empty:
assumes "kind a = Q:r↪⇘p⇙fs"
shows "upd_rev_cs cs as = [] ⟹ upd_rev_cs cs (a#as) = []"
proof(induct as arbitrary:cs rule:rev_induct)
case Nil
with ‹kind a = Q:r↪⇘p⇙fs› have "upd_rev_cs cs ([]@[a]) = []"
by(simp only:upd_rev_cs.simps) clarsimp
thus ?case by simp
next
case (snoc a' as')
note IH = ‹⋀cs. upd_rev_cs cs as' = [] ⟹ upd_rev_cs cs (a#as') = []›
show ?case
proof(cases "kind a'" rule:edge_kind_cases)
case Intra
with ‹upd_rev_cs cs (as'@[a']) = []›
have "upd_rev_cs cs as' = []" by(fastforce simp:intra_kind_def)
from IH[OF this] have "upd_rev_cs cs (a#as') = []" .
with Intra show ?thesis by(fastforce simp:intra_kind_def)
next
case Return
with ‹upd_rev_cs cs (as'@[a']) = []›
have "upd_rev_cs (a'#cs) as' = []" by simp
from IH[OF this] have "upd_rev_cs (a'#cs) (a#as') = []" .
with Return show ?thesis by simp
next
case Call
show ?thesis
proof(cases cs)
case Nil
with ‹upd_rev_cs cs (as'@[a']) = []› Call
have "upd_rev_cs cs as' = []" by simp
from IH[OF this] have "upd_rev_cs cs (a#as') = []" .
with Nil Call show ?thesis by simp
next
case (Cons cx csx)
with ‹upd_rev_cs cs (as'@[a']) = []› Call
have "upd_rev_cs csx as' = []" by simp
from IH[OF this] have "upd_rev_cs csx (a#as') = []" .
with Cons Call show ?thesis by simp
qed
qed
qed
declare append_Cons [simp] append_Cons_rev [simp del]
definition valid_call_list :: "'edge list ⇒ 'node ⇒ bool"
where "valid_call_list cs n ≡
∀cs' c cs''. cs = cs'@c#cs'' ⟶ (valid_edge c ∧ (∃Q r p fs. (kind c = Q:r↪⇘p⇙fs) ∧
p = get_proc (case cs' of [] ⇒ n | _ ⇒ last (sourcenodes cs'))))"
definition valid_return_list :: "'edge list ⇒ 'node ⇒ bool"
where "valid_return_list cs n ≡
∀cs' c cs''. cs = cs'@c#cs'' ⟶ (valid_edge c ∧ (∃Q p f. (kind c = Q↩⇘p⇙f) ∧
p = get_proc (case cs' of [] ⇒ n | _ ⇒ last (targetnodes cs'))))"
lemma valid_call_list_valid_edges:
assumes "valid_call_list cs n" shows "∀c ∈ set cs. valid_edge c"
proof -
from ‹valid_call_list cs n›
have "∀cs' c cs''. cs = cs'@c#cs'' ⟶ valid_edge c"
by(simp add:valid_call_list_def)
thus ?thesis
proof(induct cs)
case Nil thus ?case by simp
next
case (Cons cx csx)
note IH = ‹∀cs' c cs''. csx = cs'@c#cs'' ⟶ valid_edge c ⟹
∀a∈set csx. valid_edge a›
from ‹∀cs' c cs''. cx#csx = cs'@c#cs'' ⟶ valid_edge c›
have "valid_edge cx" by blast
from ‹∀cs' c cs''. cx#csx = cs'@c#cs'' ⟶ valid_edge c›
have "∀cs' c cs''. csx = cs'@c#cs'' ⟶ valid_edge c"
by auto(erule_tac x="cx#cs'" in allE,auto)
from IH[OF this] ‹valid_edge cx› show ?case by simp
qed
qed
lemma valid_return_list_valid_edges:
assumes "valid_return_list rs n" shows "∀r ∈ set rs. valid_edge r"
proof -
from ‹valid_return_list rs n›
have "∀rs' r rs''. rs = rs'@r#rs'' ⟶ valid_edge r"
by(simp add:valid_return_list_def)
thus ?thesis
proof(induct rs)
case Nil thus ?case by simp
next
case (Cons rx rsx)
note IH = ‹∀rs' r rs''. rsx = rs'@r#rs'' ⟶ valid_edge r ⟹
∀a∈set rsx. valid_edge a›
from ‹∀rs' r rs''. rx#rsx = rs'@r#rs'' ⟶ valid_edge r›
have "valid_edge rx" by blast
from ‹∀rs' r rs''. rx#rsx = rs'@r#rs'' ⟶ valid_edge r›
have "∀rs' r rs''. rsx = rs'@r#rs'' ⟶ valid_edge r"
by auto(erule_tac x="rx#rs'" in allE,auto)
from IH[OF this] ‹valid_edge rx› show ?case by simp
qed
qed
lemma vpra_empty_valid_call_list_rev:
"valid_call_list cs n ⟹ valid_path_rev_aux [] (rev cs)"
proof(induct cs arbitrary:n)
case Nil thus ?case by simp
next
case (Cons c' cs')
note IH = ‹⋀n. valid_call_list cs' n ⟹ valid_path_rev_aux [] (rev cs')›
from ‹valid_call_list (c'#cs') n› have "valid_call_list cs' (sourcenode c')"
apply(clarsimp simp:valid_call_list_def)
apply hypsubst_thin
apply(erule_tac x="c'#cs'" in allE)
apply clarsimp
by(case_tac cs',auto simp:sourcenodes_def)
from IH[OF this] have "valid_path_rev_aux [] (rev cs')" .
moreover
from ‹valid_call_list (c'#cs') n› obtain Q r p fs where "kind c' = Q:r↪⇘p⇙fs"
apply(clarsimp simp:valid_call_list_def)
by(erule_tac x="[]" in allE) fastforce
ultimately show ?case by simp
qed
lemma vpa_upd_cs_cases:
"⟦valid_path_aux cs as; valid_call_list cs n; n -as→* n'⟧
⟹ case (upd_cs cs as) of [] ⇒ (∀c ∈ set cs. ∃a ∈ set as. a ∈ get_return_edges c)
| cx#csx ⇒ valid_call_list (cx#csx) n'"
proof(induct arbitrary:n rule:vpa_induct)
case (vpa_empty cs)
from ‹n -[]→* n'› have "n = n'" by fastforce
with ‹valid_call_list cs n› show ?case by(cases cs) auto
next
case (vpa_intra cs a' as')
note IH = ‹⋀n. ⟦valid_call_list cs n; n -as'→* n'⟧
⟹ case (upd_cs cs as') of [] ⇒ ∀c∈set cs. ∃a∈set as'. a ∈ get_return_edges c
| cx#csx ⇒ valid_call_list (cx # csx) n'›
from ‹intra_kind (kind a')› have "upd_cs cs (a'#as') = upd_cs cs as'"
by(fastforce simp:intra_kind_def)
from ‹n -a'#as'→* n'› have [simp]:"n = sourcenode a'" and "valid_edge a'"
and "targetnode a' -as'→* n'" by(auto elim:path_split_Cons)
from ‹valid_edge a'› ‹intra_kind (kind a')›
have "get_proc (sourcenode a') = get_proc (targetnode a')" by(rule get_proc_intra)
with ‹valid_call_list cs n› have "valid_call_list cs (targetnode a')"
apply(clarsimp simp:valid_call_list_def)
apply(erule_tac x="cs'" in allE) apply clarsimp
by(case_tac cs') auto
from IH[OF this ‹targetnode a' -as'→* n'›] ‹upd_cs cs (a'#as') = upd_cs cs as'›
show ?case by(cases "upd_cs cs as'") auto
next
case (vpa_Call cs a' as' Q r p fs)
note IH = ‹⋀n. ⟦valid_call_list (a'#cs) n; n -as'→* n'⟧
⟹ case (upd_cs (a'#cs) as')
of [] ⇒ ∀c∈set (a'#cs). ∃a∈set as'. a ∈ get_return_edges c
| cx#csx ⇒ valid_call_list (cx # csx) n'›
from ‹kind a' = Q:r↪⇘p⇙fs› have "upd_cs (a'#cs) as' = upd_cs cs (a'#as')"
by simp
from ‹n -a'#as'→* n'› have [simp]:"n = sourcenode a'" and "valid_edge a'"
and "targetnode a' -as'→* n'" by(auto elim:path_split_Cons)
from ‹valid_edge a'› ‹kind a' = Q:r↪⇘p⇙fs›
have "get_proc (targetnode a') = p" by(rule get_proc_call)
with ‹valid_edge a'› ‹kind a' = Q:r↪⇘p⇙fs› ‹valid_call_list cs n›
have "valid_call_list (a'#cs) (targetnode a')"
apply(clarsimp simp:valid_call_list_def)
apply(case_tac cs') apply auto
apply(erule_tac x="list" in allE) apply clarsimp
by(case_tac list,auto simp:sourcenodes_def)
from IH[OF this ‹targetnode a' -as'→* n'›]
‹upd_cs (a'#cs) as' = upd_cs cs (a'#as')›
have "case upd_cs cs (a'#as')
of [] ⇒ ∀c∈set (a' # cs). ∃a∈set as'. a ∈ get_return_edges c
| cx # csx ⇒ valid_call_list (cx # csx) n'" by simp
thus ?case by(cases "upd_cs cs (a'#as')") simp+
next
case (vpa_ReturnEmpty cs a' as' Q p f)
note IH = ‹⋀n. ⟦valid_call_list [] n; n -as'→* n'⟧
⟹ case (upd_cs [] as')
of [] ⇒ ∀c∈set []. ∃a∈set as'. a ∈ get_return_edges c
| cx#csx ⇒ valid_call_list (cx # csx) n'›
from ‹kind a' = Q↩⇘p⇙f› ‹cs = []› have "upd_cs [] as' = upd_cs cs (a'#as')"
by simp
from ‹n -a'#as'→* n'› have [simp]:"n = sourcenode a'" and "valid_edge a'"
and "targetnode a' -as'→* n'" by(auto elim:path_split_Cons)
have "valid_call_list [] (targetnode a')" by(simp add:valid_call_list_def)
from IH[OF this ‹targetnode a' -as'→* n'›]
‹upd_cs [] as' = upd_cs cs (a'#as')›
have "case (upd_cs cs (a'#as'))
of [] ⇒ ∀c∈set []. ∃a∈set as'. a ∈ get_return_edges c
| cx#csx ⇒ valid_call_list (cx#csx) n'" by simp
with ‹cs = []› show ?case by(cases "upd_cs cs (a'#as')") simp+
next
case (vpa_ReturnCons cs a' as' Q p f c' cs')
note IH = ‹⋀n. ⟦valid_call_list cs' n; n -as'→* n'⟧
⟹ case (upd_cs cs' as')
of [] ⇒ ∀c∈set cs'. ∃a∈set as'. a ∈ get_return_edges c
| cx#csx ⇒ valid_call_list (cx # csx) n'›
from ‹kind a' = Q↩⇘p⇙f› ‹cs = c'#cs'› ‹a' ∈ get_return_edges c'›
have "upd_cs cs' as' = upd_cs cs (a'#as')" by simp
from ‹n -a'#as'→* n'› have [simp]:"n = sourcenode a'" and "valid_edge a'"
and "targetnode a' -as'→* n'" by(auto elim:path_split_Cons)
from ‹valid_call_list cs n› ‹cs = c'#cs'› have "valid_edge c'"
apply(clarsimp simp:valid_call_list_def)
by(erule_tac x="[]" in allE,auto)
with ‹a' ∈ get_return_edges c'› obtain ax where "valid_edge ax"
and sources:"sourcenode ax = sourcenode c'"
and targets:"targetnode ax = targetnode a'" and "kind ax = (λcf. False)⇩√"
by(fastforce dest:call_return_node_edge)
from ‹valid_edge ax› sources[THEN sym] targets[THEN sym] ‹kind ax = (λcf. False)⇩√›
have "get_proc (sourcenode c') = get_proc (targetnode a')"
by(fastforce intro:get_proc_intra simp:intra_kind_def)
with ‹valid_call_list cs n› ‹cs = c'#cs'›
have "valid_call_list cs' (targetnode a')"
apply(clarsimp simp:valid_call_list_def)
apply(hypsubst_thin)
apply(erule_tac x="c'#cs'" in allE)
by(case_tac cs',auto simp:sourcenodes_def)
from IH[OF this ‹targetnode a' -as'→* n'›]
‹upd_cs cs' as' = upd_cs cs (a'#as')›
have "case (upd_cs cs (a'#as'))
of [] ⇒ ∀c∈set cs'. ∃a∈set as'. a ∈ get_return_edges c
| cx#csx ⇒ valid_call_list (cx#csx) n'" by simp
with ‹cs = c' # cs'› ‹a' ∈ get_return_edges c'› show ?case
by(cases "upd_cs cs (a'#as')") simp+
qed
lemma vpa_valid_call_list_valid_return_list_vpra:
"⟦valid_path_aux cs cs'; valid_call_list cs n; valid_return_list cs' n'⟧
⟹ valid_path_rev_aux cs' (rev cs)"
proof(induct arbitrary:n n' rule:vpa_induct)
case (vpa_empty cs)
from ‹valid_call_list cs n› show ?case by(rule vpra_empty_valid_call_list_rev)
next
case (vpa_intra cs a as)
from ‹intra_kind (kind a)› ‹valid_return_list (a#as) n'›
have False apply(clarsimp simp:valid_return_list_def)
by(erule_tac x="[]" in allE,clarsimp simp:intra_kind_def)
thus ?case by simp
next
case (vpa_Call cs a as Q r p fs)
from ‹kind a = Q:r↪⇘p⇙fs› ‹valid_return_list (a#as) n'›
have False apply(clarsimp simp:valid_return_list_def)
by(erule_tac x="[]" in allE,clarsimp)
thus ?case by simp
next
case (vpa_ReturnEmpty cs a as Q p f)
from ‹cs = []› show ?case by simp
next
case (vpa_ReturnCons cs a as Q p f c' cs')
note IH = ‹⋀n n'. ⟦valid_call_list cs' n; valid_return_list as n'⟧
⟹ valid_path_rev_aux as (rev cs')›
from ‹valid_return_list (a#as) n'› have "valid_return_list as (targetnode a)"
apply(clarsimp simp:valid_return_list_def)
apply(erule_tac x="a#cs'" in allE)
by(case_tac cs',auto simp:targetnodes_def)
from ‹valid_call_list cs n› ‹cs = c'#cs'›
have "valid_call_list cs' (sourcenode c')"
apply(clarsimp simp:valid_call_list_def)
apply(erule_tac x="c'#cs'" in allE)
by(case_tac cs',auto simp:sourcenodes_def)
from ‹valid_call_list cs n› ‹cs = c'#cs'› have "valid_edge c'"
apply(clarsimp simp:valid_call_list_def)
by(erule_tac x="[]" in allE,auto)
with ‹a ∈ get_return_edges c'› obtain Q' r' p' f' where "kind c' = Q':r'↪⇘p'⇙f'"
apply(cases "kind c'" rule:edge_kind_cases)
by(auto dest:only_call_get_return_edges simp:intra_kind_def)
from IH[OF ‹valid_call_list cs' (sourcenode c')›
‹valid_return_list as (targetnode a)›]
have "valid_path_rev_aux as (rev cs')" .
with ‹kind a = Q↩⇘p⇙f› ‹cs = c'#cs'› ‹a ∈ get_return_edges c'› ‹kind c' = Q':r'↪⇘p'⇙f'›
show ?case by simp
qed
lemma vpa_to_vpra:
"⟦valid_path_aux cs as; valid_path_aux (upd_cs cs as) cs';
n -as→* n'; valid_call_list cs n; valid_return_list cs' n''⟧
⟹ valid_path_rev_aux cs' as ∧ valid_path_rev_aux (upd_rev_cs cs' as) (rev cs)"
proof(induct arbitrary:n rule:vpa_induct)
case vpa_empty thus ?case
by(fastforce intro:vpa_valid_call_list_valid_return_list_vpra)
next
case (vpa_intra cs a as)
note IH = ‹⋀n. ⟦valid_path_aux (upd_cs cs as) cs'; n -as→* n';
valid_call_list cs n; valid_return_list cs' n''⟧
⟹ valid_path_rev_aux cs' as ∧
valid_path_rev_aux (upd_rev_cs cs' as) (rev cs)›
from ‹n -a#as→* n'› have "n = sourcenode a" and "valid_edge a"
and "targetnode a -as→* n'" by(auto intro:path_split_Cons)
from ‹valid_edge a› ‹intra_kind (kind a)›
have "get_proc (sourcenode a) = get_proc (targetnode a)" by(rule get_proc_intra)
with ‹valid_call_list cs n› ‹n = sourcenode a›
have "valid_call_list cs (targetnode a)"
apply(clarsimp simp:valid_call_list_def)
apply(erule_tac x="cs'" in allE) apply clarsimp
by(case_tac cs') auto
from ‹valid_path_aux (upd_cs cs (a#as)) cs'› ‹intra_kind (kind a)›
have "valid_path_aux (upd_cs cs as) cs'"
by(fastforce simp:intra_kind_def)
from IH[OF this ‹targetnode a -as→* n'› ‹valid_call_list cs (targetnode a)›
‹valid_return_list cs' n''›]
have "valid_path_rev_aux cs' as"
and "valid_path_rev_aux (upd_rev_cs cs' as) (rev cs)" by simp_all
from ‹intra_kind (kind a)› ‹valid_path_rev_aux cs' as›
have "valid_path_rev_aux cs' (a#as)" by(rule vpra_Cons_intra)
from ‹intra_kind (kind a)› have "upd_rev_cs cs' (a#as) = upd_rev_cs cs' as"
by(simp add:upd_rev_cs_Cons_intra)
with ‹valid_path_rev_aux (upd_rev_cs cs' as) (rev cs)›
have "valid_path_rev_aux (upd_rev_cs cs' (a#as)) (rev cs)" by simp
with ‹valid_path_rev_aux cs' (a#as)› show ?case by simp
next
case (vpa_Call cs a as Q r p fs)
note IH = ‹⋀n. ⟦valid_path_aux (upd_cs (a#cs) as) cs'; n -as→* n';
valid_call_list (a#cs) n; valid_return_list cs' n''⟧
⟹ valid_path_rev_aux cs' as ∧
valid_path_rev_aux (upd_rev_cs cs' as) (rev (a#cs))›
from ‹n -a#as→* n'› have "n = sourcenode a" and "valid_edge a"
and "targetnode a -as→* n'" by(auto intro:path_split_Cons)
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› have "p = get_proc (targetnode a)"
by(rule get_proc_call[THEN sym])
from ‹valid_call_list cs n› ‹n = sourcenode a›
have "valid_call_list cs (sourcenode a)" by simp
with ‹kind a = Q:r↪⇘p⇙fs› ‹valid_edge a› ‹p = get_proc (targetnode a)›
have "valid_call_list (a#cs) (targetnode a)"
apply(clarsimp simp:valid_call_list_def)
apply(case_tac cs') apply auto
apply(erule_tac x="list" in allE) apply clarsimp
by(case_tac list,auto simp:sourcenodes_def)
from ‹kind a = Q:r↪⇘p⇙fs› have "upd_cs cs (a#as) = upd_cs (a#cs) as"
by simp
with ‹valid_path_aux (upd_cs cs (a#as)) cs'›
have "valid_path_aux (upd_cs (a#cs) as) cs'" by simp
from IH[OF this ‹targetnode a -as→* n'› ‹valid_call_list (a#cs) (targetnode a)›
‹valid_return_list cs' n''›]
have "valid_path_rev_aux cs' as"
and "valid_path_rev_aux (upd_rev_cs cs' as) (rev (a#cs))" by simp_all
show ?case
proof(cases "upd_rev_cs cs' as")
case Nil
with ‹kind a = Q:r↪⇘p⇙fs›
have "upd_rev_cs cs' (a#as) = []" by(rule upd_rev_cs_Cons_Call_Cons_Empty)
with ‹valid_path_rev_aux (upd_rev_cs cs' as) (rev (a#cs))› ‹kind a = Q:r↪⇘p⇙fs› Nil
have "valid_path_rev_aux (upd_rev_cs cs' (a#as)) (rev cs)" by simp
from Nil ‹kind a = Q:r↪⇘p⇙fs› have "valid_path_rev_aux (upd_rev_cs cs' as) ([]@[a])"
by(simp only:valid_path_rev_aux.simps) clarsimp
with ‹valid_path_rev_aux cs' as› have "valid_path_rev_aux cs' ([a]@as)"
by(fastforce intro:valid_path_rev_aux_Append)
with ‹valid_path_rev_aux (upd_rev_cs cs' (a#as)) (rev cs)›
show ?thesis by simp
next
case (Cons cx csx)
with ‹valid_path_rev_aux (upd_rev_cs cs' as) (rev (a#cs))› ‹kind a = Q:r↪⇘p⇙fs›
have match:"cx ∈ get_return_edges a" "valid_path_rev_aux csx (rev cs)" by auto
from ‹kind a = Q:r↪⇘p⇙fs› Cons have "upd_rev_cs cs' (a#as) = csx"
by(rule upd_rev_cs_Cons_Call_Cons)
with ‹valid_path_rev_aux (upd_rev_cs cs' as) (rev(a#cs))› ‹kind a = Q:r↪⇘p⇙fs› match
have "valid_path_rev_aux (upd_rev_cs cs' (a#as)) (rev cs)" by simp
from Cons ‹kind a = Q:r↪⇘p⇙fs› match
have "valid_path_rev_aux (upd_rev_cs cs' as) ([]@[a])"
by(simp only:valid_path_rev_aux.simps) clarsimp
with ‹valid_path_rev_aux cs' as› have "valid_path_rev_aux cs' ([a]@as)"
by(fastforce intro:valid_path_rev_aux_Append)
with ‹valid_path_rev_aux (upd_rev_cs cs' (a#as)) (rev cs)›
show ?thesis by simp
qed
next
case (vpa_ReturnEmpty cs a as Q p f)
note IH = ‹⋀n. ⟦valid_path_aux (upd_cs [] as) cs'; n -as→* n';
valid_call_list [] n; valid_return_list cs' n''⟧
⟹ valid_path_rev_aux cs' as ∧
valid_path_rev_aux (upd_rev_cs cs' as) (rev [])›
from ‹n -a#as→* n'› have "n = sourcenode a" and "valid_edge a"
and "targetnode a -as→* n'" by(auto intro:path_split_Cons)
from ‹cs = []› ‹kind a = Q↩⇘p⇙f› have "upd_cs cs (a#as) = upd_cs [] as"
by simp
with ‹valid_path_aux (upd_cs cs (a#as)) cs'›
have "valid_path_aux (upd_cs [] as) cs'" by simp
from IH[OF this ‹targetnode a -as→* n'› _ ‹valid_return_list cs' n''›]
have "valid_path_rev_aux cs' as"
and "valid_path_rev_aux (upd_rev_cs cs' as) (rev [])"
by(auto simp:valid_call_list_def)
from ‹kind a = Q↩⇘p⇙f› ‹valid_path_rev_aux cs' as›
have "valid_path_rev_aux cs' (a#as)" by(rule vpra_Cons_Return)
moreover
from ‹cs = []› have "valid_path_rev_aux (upd_rev_cs cs' (a#as)) (rev cs)"
by simp
ultimately show ?case by simp
next
case (vpa_ReturnCons cs a as Q p f cx csx)
note IH = ‹⋀n. ⟦valid_path_aux (upd_cs csx as) cs'; n -as→* n';
valid_call_list csx n; valid_return_list cs' n''⟧
⟹ valid_path_rev_aux cs' as ∧
valid_path_rev_aux (upd_rev_cs cs' as) (rev csx)›
note match = ‹cs = cx#csx› ‹a ∈ get_return_edges cx›
from ‹n -a#as→* n'› have "n = sourcenode a" and "valid_edge a"
and "targetnode a -as→* n'" by(auto intro:path_split_Cons)
from ‹cs = cx#csx› ‹valid_call_list cs n› have "valid_edge cx"
apply(clarsimp simp:valid_call_list_def)
by(erule_tac x="[]" in allE) clarsimp
with match have "get_proc (sourcenode cx) = get_proc (targetnode a)"
by(fastforce intro:get_proc_get_return_edge)
with ‹valid_call_list cs n› ‹cs = cx#csx›
have "valid_call_list csx (targetnode a)"
apply(clarsimp simp:valid_call_list_def)
apply(erule_tac x="cx#cs'" in allE) apply clarsimp
by(case_tac cs',auto simp:sourcenodes_def)
from ‹kind a = Q↩⇘p⇙f› match have "upd_cs cs (a#as) = upd_cs csx as" by simp
with ‹valid_path_aux (upd_cs cs (a#as)) cs'›
have "valid_path_aux (upd_cs csx as) cs'" by simp
from IH[OF this ‹targetnode a -as→* n'› ‹valid_call_list csx (targetnode a)›
‹valid_return_list cs' n''›]
have "valid_path_rev_aux cs' as"
and "valid_path_rev_aux (upd_rev_cs cs' as) (rev csx)" by simp_all
from ‹kind a = Q↩⇘p⇙f› ‹valid_path_rev_aux cs' as›
have "valid_path_rev_aux cs' (a#as)" by(rule vpra_Cons_Return)
from match ‹valid_edge cx› obtain Q' r' p' f' where "kind cx = Q':r'↪⇘p'⇙f'"
by(fastforce dest!:only_call_get_return_edges)
from ‹kind a = Q↩⇘p⇙f› have "upd_rev_cs cs' (a#as) = a#(upd_rev_cs cs' as)"
by(rule upd_rev_cs_Cons_Return)
with ‹valid_path_rev_aux (upd_rev_cs cs' as) (rev csx)› ‹kind a = Q↩⇘p⇙f›
‹kind cx = Q':r'↪⇘p'⇙f'› match
have "valid_path_rev_aux (upd_rev_cs cs' (a#as)) (rev cs)"
by simp
with ‹valid_path_rev_aux cs' (a#as)› show ?case by simp
qed
lemma vp_to_vpra:
"n -as→⇩√* n' ⟹ valid_path_rev_aux [] as"
by(fastforce elim:vpa_to_vpra[THEN conjunct1]
simp:vp_def valid_path_def valid_call_list_def valid_return_list_def)
subsubsection ‹Same level paths›
fun same_level_path_aux :: "'edge list ⇒ 'edge list ⇒ bool"
where "same_level_path_aux cs [] ⟷ True"
| "same_level_path_aux cs (a#as) ⟷
(case (kind a) of Q:r↪⇘p⇙fs ⇒ same_level_path_aux (a#cs) as
| Q↩⇘p⇙f ⇒ case cs of [] ⇒ False
| c'#cs' ⇒ a ∈ get_return_edges c' ∧
same_level_path_aux cs' as
| _ ⇒ same_level_path_aux cs as)"
lemma slpa_induct [consumes 1,case_names slpa_empty slpa_intra slpa_Call
slpa_Return]:
assumes major: "same_level_path_aux xs ys"
and rules: "⋀cs. P cs []"
"⋀cs a as. ⟦intra_kind(kind a); same_level_path_aux cs as; P cs as⟧
⟹ P cs (a#as)"
"⋀cs a as Q r p fs. ⟦kind a = Q:r↪⇘p⇙fs; same_level_path_aux (a#cs) as; P (a#cs) as⟧
⟹ P cs (a#as)"
"⋀cs a as Q p f c' cs'. ⟦kind a = Q↩⇘p⇙f; cs = c'#cs'; same_level_path_aux cs' as;
a ∈ get_return_edges c'; P cs' as⟧
⟹ P cs (a#as)"
shows "P xs ys"
using major
apply(induct ys arbitrary: xs)
by(auto intro:rules split:edge_kind.split_asm list.split_asm simp:intra_kind_def)
lemma slpa_cases [consumes 4,case_names intra_path return_intra_path]:
assumes "same_level_path_aux cs as" and "upd_cs cs as = []"
and "∀c ∈ set cs. valid_edge c" and "∀a ∈ set as. valid_edge a"
obtains "∀a ∈ set as. intra_kind(kind a)"
| asx a asx' Q p f c' cs' where "as = asx@a#asx'" and "same_level_path_aux cs asx"
and "kind a = Q↩⇘p⇙f" and "upd_cs cs asx = c'#cs'" and "upd_cs cs (asx@[a]) = []"
and "a ∈ get_return_edges c'" and "valid_edge c'"
and "∀a ∈ set asx'. intra_kind(kind a)"
proof(atomize_elim)
from assms
show "(∀a∈set as. intra_kind (kind a)) ∨
(∃asx a asx' Q p f c' cs'. as = asx@a#asx' ∧ same_level_path_aux cs asx ∧
kind a = Q↩⇘p⇙f ∧ upd_cs cs asx = c'#cs' ∧ upd_cs cs (asx@[a]) = [] ∧
a ∈ get_return_edges c' ∧ valid_edge c' ∧ (∀a∈set asx'. intra_kind (kind a)))"
proof(induct rule:slpa_induct)
case (slpa_empty cs)
have "∀a∈set []. intra_kind (kind a)" by simp
thus ?case by simp
next
case (slpa_intra cs a as)
note IH = ‹⟦upd_cs cs as = []; ∀c∈set cs. valid_edge c; ∀a'∈set as. valid_edge a'⟧
⟹ (∀a∈set as. intra_kind (kind a)) ∨
(∃asx a asx' Q p f c' cs'. as = asx@a#asx' ∧ same_level_path_aux cs asx ∧
kind a = Q↩⇘p⇙f ∧ upd_cs cs asx = c' # cs' ∧ upd_cs cs (asx@[a]) = [] ∧
a ∈ get_return_edges c' ∧ valid_edge c' ∧ (∀a∈set asx'. intra_kind (kind a)))›
from ‹∀a'∈set (a#as). valid_edge a'› have "∀a'∈set as. valid_edge a'" by simp
from ‹intra_kind (kind a)› ‹upd_cs cs (a#as) = []›
have "upd_cs cs as = []" by(fastforce simp:intra_kind_def)
from IH[OF this ‹∀c∈set cs. valid_edge c› ‹∀a'∈set as. valid_edge a'›] show ?case
proof
assume "∀a∈set as. intra_kind (kind a)"
with ‹intra_kind (kind a)› have "∀a'∈set (a#as). intra_kind (kind a')"
by simp
thus ?case by simp
next
assume "∃asx a asx' Q p f c' cs'. as = asx@a#asx' ∧ same_level_path_aux cs asx ∧
kind a = Q↩⇘p⇙f ∧ upd_cs cs asx = c'#cs' ∧ upd_cs cs (asx@[a]) = [] ∧
a ∈ get_return_edges c' ∧ valid_edge c' ∧
(∀a∈set asx'. intra_kind (kind a))"
then obtain asx a' Q p f asx' c' cs' where "as = asx@a'#asx'"
and "same_level_path_aux cs asx" and "upd_cs cs (asx@[a']) = []"
and "upd_cs cs asx = c'#cs'" and assms:"a' ∈ get_return_edges c'"
"kind a' = Q↩⇘p⇙f" "valid_edge c'" "∀a∈set asx'. intra_kind (kind a)"
by blast
from ‹as = asx@a'#asx'› have "a#as = (a#asx)@a'#asx'" by simp
moreover
from ‹intra_kind (kind a)› ‹same_level_path_aux cs asx›
have "same_level_path_aux cs (a#asx)" by(fastforce simp:intra_kind_def)
moreover
from ‹upd_cs cs asx = c'#cs'› ‹intra_kind (kind a)›
have "upd_cs cs (a#asx) = c'#cs'" by(fastforce simp:intra_kind_def)
moreover
from ‹upd_cs cs (asx@[a']) = []› ‹intra_kind (kind a)›
have "upd_cs cs ((a#asx)@[a']) = []" by(fastforce simp:intra_kind_def)
ultimately show ?case using assms by blast
qed
next
case (slpa_Call cs a as Q r p fs)
note IH = ‹⟦upd_cs (a#cs) as = []; ∀c∈set (a#cs). valid_edge c;
∀a'∈set as. valid_edge a'⟧ ⟹
(∀a'∈set as. intra_kind (kind a')) ∨
(∃asx a' asx' Q' p' f' c' cs'. as = asx@a'#asx' ∧
same_level_path_aux (a#cs) asx ∧ kind a' = Q'↩⇘p'⇙f' ∧
upd_cs (a#cs) asx = c'#cs' ∧ upd_cs (a#cs) (asx@[a']) = [] ∧
a' ∈ get_return_edges c' ∧ valid_edge c' ∧
(∀a'∈set asx'. intra_kind (kind a')))›
from ‹∀a'∈set (a#as). valid_edge a'› have "valid_edge a"
and "∀a'∈set as. valid_edge a'" by simp_all
from ‹∀c∈set cs. valid_edge c› ‹valid_edge a› have "∀c∈set (a#cs). valid_edge c"
by simp
from ‹upd_cs cs (a#as) = []› ‹kind a = Q:r↪⇘p⇙fs›
have "upd_cs (a#cs) as = []" by simp
from IH[OF this ‹∀c∈set (a#cs). valid_edge c› ‹∀a'∈set as. valid_edge a'›]
show ?case
proof
assume "∀a'∈set as. intra_kind (kind a')"
with ‹kind a = Q:r↪⇘p⇙fs› have "upd_cs cs (a#as) = a#cs"
by(fastforce intro:upd_cs_intra_path)
with ‹upd_cs cs (a#as) = []› have False by simp
thus ?case by simp
next
assume "∃asx a' asx' Q p f c' cs'. as = asx@a'#asx' ∧
same_level_path_aux (a#cs) asx ∧ kind a' = Q↩⇘p⇙f ∧
upd_cs (a#cs) asx = c'#cs' ∧ upd_cs (a#cs) (asx@[a']) = [] ∧
a' ∈ get_return_edges c' ∧ valid_edge c' ∧
(∀a∈set asx'. intra_kind (kind a))"
then obtain asx a' Q' p' f' asx' c' cs' where "as = asx@a'#asx'"
and "same_level_path_aux (a#cs) asx" and "upd_cs (a#cs) (asx@[a']) = []"
and "upd_cs (a#cs) asx = c'#cs'" and assms:"a' ∈ get_return_edges c'"
"kind a' = Q'↩⇘p'⇙f'" "valid_edge c'" "∀a∈set asx'. intra_kind (kind a)"
by blast
from ‹as = asx@a'#asx'› have "a#as = (a#asx)@a'#asx'" by simp
moreover
from ‹kind a = Q:r↪⇘p⇙fs› ‹same_level_path_aux (a#cs) asx›
have "same_level_path_aux cs (a#asx)" by simp
moreover
from ‹kind a = Q:r↪⇘p⇙fs› ‹upd_cs (a#cs) asx = c'#cs'›
have "upd_cs cs (a#asx) = c'#cs'" by simp
moreover
from ‹kind a = Q:r↪⇘p⇙fs› ‹upd_cs (a#cs) (asx@[a']) = []›
have "upd_cs cs ((a#asx)@[a']) = []" by simp
ultimately show ?case using assms by blast
qed
next
case (slpa_Return cs a as Q p f c' cs')
note IH = ‹⟦upd_cs cs' as = []; ∀c∈set cs'. valid_edge c;
∀a'∈set as. valid_edge a'⟧ ⟹
(∀a'∈set as. intra_kind (kind a')) ∨
(∃asx a' asx' Q' p' f' c'' cs''. as = asx@a'#asx' ∧
same_level_path_aux cs' asx ∧ kind a' = Q'↩⇘p'⇙f' ∧ upd_cs cs' asx = c''#cs'' ∧
upd_cs cs' (asx@[a']) = [] ∧ a' ∈ get_return_edges c'' ∧ valid_edge c'' ∧
(∀a'∈set asx'. intra_kind (kind a')))›
from ‹∀a'∈set (a#as). valid_edge a'› have "valid_edge a"
and "∀a'∈set as. valid_edge a'" by simp_all
from ‹∀c∈set cs. valid_edge c› ‹cs = c' # cs'›
have "valid_edge c'" and "∀c∈set cs'. valid_edge c" by simp_all
from ‹upd_cs cs (a#as) = []› ‹kind a = Q↩⇘p⇙f› ‹cs = c'#cs'›
‹a ∈ get_return_edges c'› have "upd_cs cs' as = []" by simp
from IH[OF this ‹∀c∈set cs'. valid_edge c› ‹∀a'∈set as. valid_edge a'›] show ?case
proof
assume "∀a'∈set as. intra_kind (kind a')"
hence "upd_cs cs' as = cs'" by(rule upd_cs_intra_path)
with ‹upd_cs cs' as = []› have "cs' = []" by simp
with ‹cs = c'#cs'› ‹a ∈ get_return_edges c'› ‹kind a = Q↩⇘p⇙f›
have "upd_cs cs [a] = []" by simp
moreover
from ‹cs = c'#cs'› have "upd_cs cs [] ≠ []" by simp
moreover
have "same_level_path_aux cs []" by simp
ultimately show ?case
using ‹kind a = Q↩⇘p⇙f› ‹∀a'∈set as. intra_kind (kind a')› ‹cs = c'#cs'›
‹a ∈ get_return_edges c'› ‹valid_edge c'›
by fastforce
next
assume "∃asx a' asx' Q' p' f' c'' cs''. as = asx@a'#asx' ∧
same_level_path_aux cs' asx ∧ kind a' = Q'↩⇘p'⇙f' ∧ upd_cs cs' asx = c''#cs'' ∧
upd_cs cs' (asx@[a']) = [] ∧ a' ∈ get_return_edges c'' ∧ valid_edge c'' ∧
(∀a'∈set asx'. intra_kind (kind a'))"
then obtain asx a' asx' Q' p' f' c'' cs'' where "as = asx@a'#asx'"
and "same_level_path_aux cs' asx" and "upd_cs cs' asx = c''#cs''"
and "upd_cs cs' (asx@[a']) = []" and assms:"a' ∈ get_return_edges c''"
"kind a' = Q'↩⇘p'⇙f'" "valid_edge c''" "∀a'∈set asx'. intra_kind (kind a')"
by blast
from ‹as = asx@a'#asx'› have "a#as = (a#asx)@a'#asx'" by simp
moreover
from ‹same_level_path_aux cs' asx› ‹cs = c'#cs'› ‹a ∈ get_return_edges c'›
‹kind a = Q↩⇘p⇙f›
have "same_level_path_aux cs (a#asx)" by simp
moreover
from ‹upd_cs cs' asx = c''#cs''› ‹kind a = Q↩⇘p⇙f› ‹cs = c'#cs'›
have "upd_cs cs (a#asx) = c''#cs''" by simp
moreover
from ‹upd_cs cs' (asx@[a']) = []› ‹cs = c'#cs'› ‹a ∈ get_return_edges c'›
‹kind a = Q↩⇘p⇙f›
have "upd_cs cs ((a#asx)@[a']) = []" by simp
ultimately show ?case using assms by blast
qed
qed
qed
lemma same_level_path_aux_valid_path_aux:
"same_level_path_aux cs as ⟹ valid_path_aux cs as"
by(induct rule:slpa_induct,auto split:edge_kind.split simp:intra_kind_def)
lemma same_level_path_aux_Append:
"⟦same_level_path_aux cs as; same_level_path_aux (upd_cs cs as) as'⟧
⟹ same_level_path_aux cs (as@as')"
by(induct rule:slpa_induct,auto simp:intra_kind_def)
lemma same_level_path_aux_callstack_Append:
"same_level_path_aux cs as ⟹ same_level_path_aux (cs@cs') as"
by(induct rule:slpa_induct,auto simp:intra_kind_def)
lemma same_level_path_upd_cs_callstack_Append:
"⟦same_level_path_aux cs as; upd_cs cs as = cs'⟧
⟹ upd_cs (cs@cs'') as = (cs'@cs'')"
by(induct rule:slpa_induct,auto split:edge_kind.split simp:intra_kind_def)
lemma slpa_split:
assumes "same_level_path_aux cs as" and "as = xs@ys" and "upd_cs cs xs = []"
shows "same_level_path_aux cs xs" and "same_level_path_aux [] ys"
using assms
proof(induct arbitrary:xs ys rule:slpa_induct)
case (slpa_empty cs) case 1
from ‹[] = xs@ys› show ?case by simp
next
case (slpa_empty cs) case 2
from ‹[] = xs@ys› show ?case by simp
next
case (slpa_intra cs a as)
note IH1 = ‹⋀xs ys. ⟦as = xs@ys; upd_cs cs xs = []⟧ ⟹ same_level_path_aux cs xs›
note IH2 = ‹⋀xs ys. ⟦as = xs@ys; upd_cs cs xs = []⟧ ⟹ same_level_path_aux [] ys›
{ case 1
show ?case
proof(cases xs)
case Nil thus ?thesis by simp
next
case (Cons x' xs')
with ‹a#as = xs@ys› have "a = x'" and "as = xs'@ys" by simp_all
with ‹upd_cs cs xs = []› Cons ‹intra_kind (kind a)›
have "upd_cs cs xs' = []" by(fastforce simp:intra_kind_def)
from IH1[OF ‹as = xs'@ys› this] have "same_level_path_aux cs xs'" .
with ‹a = x'› ‹intra_kind (kind a)› Cons
show ?thesis by(fastforce simp:intra_kind_def)
qed
next
case 2
show ?case
proof(cases xs)
case Nil
with ‹upd_cs cs xs = []› have "cs = []" by fastforce
with Nil ‹a#as = xs@ys› ‹same_level_path_aux cs as› ‹intra_kind (kind a)›
show ?thesis by(cases ys,auto simp:intra_kind_def)
next
case (Cons x' xs')
with ‹a#as = xs@ys› have "a = x'" and "as = xs'@ys" by simp_all
with ‹upd_cs cs xs = []› Cons ‹intra_kind (kind a)›
have "upd_cs cs xs' = []" by(fastforce simp:intra_kind_def)
from IH2[OF ‹as = xs'@ys› this] show ?thesis .
qed
}
next
case (slpa_Call cs a as Q r p fs)
note IH1 = ‹⋀xs ys. ⟦as = xs@ys; upd_cs (a#cs) xs = []⟧
⟹ same_level_path_aux (a#cs) xs›
note IH2 = ‹⋀xs ys. ⟦as = xs@ys; upd_cs (a#cs) xs = []⟧
⟹ same_level_path_aux [] ys›
{ case 1
show ?case
proof(cases xs)
case Nil thus ?thesis by simp
next
case (Cons x' xs')
with ‹a#as = xs@ys› have "a = x'" and "as = xs'@ys" by simp_all
with ‹upd_cs cs xs = []› Cons ‹kind a = Q:r↪⇘p⇙fs›
have "upd_cs (a#cs) xs' = []" by simp
from IH1[OF ‹as = xs'@ys› this] have "same_level_path_aux (a#cs) xs'" .
with ‹a = x'› ‹kind a = Q:r↪⇘p⇙fs› Cons show ?thesis by simp
qed
next
case 2
show ?case
proof(cases xs)
case Nil
with ‹upd_cs cs xs = []› have "cs = []" by fastforce
with Nil ‹a#as = xs@ys› ‹same_level_path_aux (a#cs) as› ‹kind a = Q:r↪⇘p⇙fs›
show ?thesis by(cases ys) auto
next
case (Cons x' xs')
with ‹a#as = xs@ys› have "a = x'" and "as = xs'@ys" by simp_all
with ‹upd_cs cs xs = []› Cons ‹kind a = Q:r↪⇘p⇙fs›
have "upd_cs (a#cs) xs' = []" by simp
from IH2[OF ‹as = xs'@ys› this] show ?thesis .
qed
}
next
case (slpa_Return cs a as Q p f c' cs')
note IH1 = ‹⋀xs ys. ⟦as = xs@ys; upd_cs cs' xs = []⟧ ⟹ same_level_path_aux cs' xs›
note IH2 = ‹⋀xs ys. ⟦as = xs@ys; upd_cs cs' xs = []⟧ ⟹ same_level_path_aux [] ys›
{ case 1
show ?case
proof(cases xs)
case Nil thus ?thesis by simp
next
case (Cons x' xs')
with ‹a#as = xs@ys› have "a = x'" and "as = xs'@ys" by simp_all
with ‹upd_cs cs xs = []› Cons ‹kind a = Q↩⇘p⇙f› ‹cs = c'#cs'›
have "upd_cs cs' xs' = []" by simp
from IH1[OF ‹as = xs'@ys› this] have "same_level_path_aux cs' xs'" .
with ‹a = x'› ‹kind a = Q↩⇘p⇙f› ‹cs = c'#cs'› ‹a ∈ get_return_edges c'› Cons
show ?thesis by simp
qed
next
case 2
show ?case
proof(cases xs)
case Nil
with ‹upd_cs cs xs = []› have "cs = []" by fastforce
with ‹cs = c'#cs'› have False by simp
thus ?thesis by simp
next
case (Cons x' xs')
with ‹a#as = xs@ys› have "a = x'" and "as = xs'@ys" by simp_all
with ‹upd_cs cs xs = []› Cons ‹kind a = Q↩⇘p⇙f› ‹cs = c'#cs'›
have "upd_cs cs' xs' = []" by simp
from IH2[OF ‹as = xs'@ys› this] show ?thesis .
qed
}
qed
lemma slpa_number_Calls_eq_number_Returns:
"⟦same_level_path_aux cs as; upd_cs cs as = [];
∀a ∈ set as. valid_edge a; ∀c ∈ set cs. valid_edge c⟧
⟹ length [a←as@cs. ∃Q r p fs. kind a = Q:r↪⇘p⇙fs] =
length [a←as. ∃Q p f. kind a = Q↩⇘p⇙f]"
apply(induct rule:slpa_induct)
by(auto split:list.split edge_kind.split intro:only_call_get_return_edges
simp:intra_kind_def)
lemma slpa_get_proc:
"⟦same_level_path_aux cs as; upd_cs cs as = []; n -as→* n';
∀c ∈ set cs. valid_edge c⟧
⟹ (if cs = [] then get_proc n else get_proc(last(sourcenodes cs))) = get_proc n'"
proof(induct arbitrary:n rule:slpa_induct)
case slpa_empty thus ?case by fastforce
next
case (slpa_intra cs a as)
note IH = ‹⋀n. ⟦upd_cs cs as = []; n -as→* n'; ∀a∈set cs. valid_edge a⟧
⟹ (if cs = [] then get_proc n else get_proc (last (sourcenodes cs))) =
get_proc n'›
from ‹intra_kind (kind a)› ‹upd_cs cs (a#as) = []›
have "upd_cs cs as = []" by(cases "kind a",auto simp:intra_kind_def)
from ‹n -a#as→* n'› have "n -[]@a#as→* n'" by simp
hence "valid_edge a" and "n = sourcenode a" and "targetnode a -as→* n'"
by(fastforce dest:path_split)+
from ‹valid_edge a› ‹intra_kind (kind a)› ‹ n = sourcenode a›
have "get_proc n = get_proc (targetnode a)"
by(fastforce intro:get_proc_intra)
from IH[OF ‹upd_cs cs as = []› ‹targetnode a -as→* n'› ‹∀a∈set cs. valid_edge a›]
have "(if cs = [] then get_proc (targetnode a)
else get_proc (last (sourcenodes cs))) = get_proc n'" .
with ‹get_proc n = get_proc (targetnode a)› show ?case by auto
next
case (slpa_Call cs a as Q r p fs)
note IH = ‹⋀n. ⟦upd_cs (a#cs) as = []; n -as→* n'; ∀a∈set (a#cs). valid_edge a⟧
⟹ (if a#cs = [] then get_proc n else get_proc (last (sourcenodes (a#cs)))) =
get_proc n'›
from ‹kind a = Q:r↪⇘p⇙fs› ‹upd_cs cs (a#as) = []›
have "upd_cs (a#cs) as = []" by simp
from ‹n -a#as→* n'› have "n -[]@a#as→* n'" by simp
hence "valid_edge a" and "n = sourcenode a" and "targetnode a -as→* n'"
by(fastforce dest:path_split)+
from ‹valid_edge a› ‹∀a∈set cs. valid_edge a› have "∀a∈set (a#cs). valid_edge a"
by simp
from IH[OF ‹upd_cs (a#cs) as = []› ‹targetnode a -as→* n'› this]
have "get_proc (last (sourcenodes (a#cs))) = get_proc n'" by simp
with ‹n = sourcenode a› show ?case by(cases cs,auto simp:sourcenodes_def)
next
case (slpa_Return cs a as Q p f c' cs')
note IH = ‹⋀n. ⟦upd_cs cs' as = []; n -as→* n'; ∀a∈set cs'. valid_edge a⟧
⟹ (if cs' = [] then get_proc n else get_proc (last (sourcenodes cs'))) =
get_proc n'›
from ‹∀a∈set cs. valid_edge a› ‹cs = c'#cs'›
have "valid_edge c'" and "∀a∈set cs'. valid_edge a" by simp_all
from ‹kind a = Q↩⇘p⇙f› ‹upd_cs cs (a#as) = []› ‹cs = c'#cs'›
have "upd_cs cs' as = []" by simp
from ‹n -a#as→* n'› have "n -[]@a#as→* n'" by simp
hence "n = sourcenode a" and "targetnode a -as→* n'"
by(fastforce dest:path_split)+
from ‹valid_edge c'› ‹a ∈ get_return_edges c'›
have "get_proc (sourcenode c') = get_proc (targetnode a)"
by(rule get_proc_get_return_edge)
from IH[OF ‹upd_cs cs' as = []› ‹targetnode a -as→* n'› ‹∀a∈set cs'. valid_edge a›]
have "(if cs' = [] then get_proc (targetnode a)
else get_proc (last (sourcenodes cs'))) = get_proc n'" .
with ‹cs = c'#cs'› ‹get_proc (sourcenode c') = get_proc (targetnode a)›
show ?case by(auto simp:sourcenodes_def)
qed
lemma slpa_get_return_edges:
"⟦same_level_path_aux cs as; cs ≠ []; upd_cs cs as = [];
∀xs ys. as = xs@ys ∧ ys ≠ [] ⟶ upd_cs cs xs ≠ []⟧
⟹ last as ∈ get_return_edges (last cs)"
proof(induct rule:slpa_induct)
case (slpa_empty cs)
from ‹cs ≠ []› ‹upd_cs cs [] = []› have False by fastforce
thus ?case by simp
next
case (slpa_intra cs a as)
note IH = ‹⟦cs ≠ []; upd_cs cs as = [];
∀xs ys. as = xs@ys ∧ ys ≠ [] ⟶ upd_cs cs xs ≠ []⟧
⟹ last as ∈ get_return_edges (last cs)›
show ?case
proof(cases "as = []")
case True
with ‹intra_kind (kind a)› ‹upd_cs cs (a#as) = []› have "cs = []"
by(fastforce simp:intra_kind_def)
with ‹cs ≠ []› have False by simp
thus ?thesis by simp
next
case False
from ‹intra_kind (kind a)› ‹upd_cs cs (a#as) = []› have "upd_cs cs as = []"
by(fastforce simp:intra_kind_def)
from ‹∀xs ys. a#as = xs@ys ∧ ys ≠ [] ⟶ upd_cs cs xs ≠ []› ‹intra_kind (kind a)›
have "∀xs ys. as = xs@ys ∧ ys ≠ [] ⟶ upd_cs cs xs ≠ []"
apply(clarsimp,erule_tac x="a#xs" in allE)
by(auto simp:intra_kind_def)
from IH[OF ‹cs ≠ []› ‹upd_cs cs as = []› this]
have "last as ∈ get_return_edges (last cs)" .
with False show ?thesis by simp
qed
next
case (slpa_Call cs a as Q r p fs)
note IH = ‹⟦a#cs ≠ []; upd_cs (a#cs) as = [];
∀xs ys. as = xs@ys ∧ ys ≠ [] ⟶ upd_cs (a#cs) xs ≠ []⟧
⟹ last as ∈ get_return_edges (last (a#cs))›
show ?case
proof(cases "as = []")
case True
with ‹kind a = Q:r↪⇘p⇙fs› ‹upd_cs cs (a#as) = []› have "a#cs = []" by simp
thus ?thesis by simp
next
case False
from ‹kind a = Q:r↪⇘p⇙fs› ‹upd_cs cs (a#as) = []› have "upd_cs (a#cs) as = []"
by simp
from ‹∀xs ys. a#as = xs@ys ∧ ys ≠ [] ⟶ upd_cs cs xs ≠ []› ‹kind a = Q:r↪⇘p⇙fs›
have "∀xs ys. as = xs@ys ∧ ys ≠ [] ⟶ upd_cs (a#cs) xs ≠ []"
by(clarsimp,erule_tac x="a#xs" in allE,simp)
from IH[OF _ ‹upd_cs (a#cs) as = []› this]
have "last as ∈ get_return_edges (last (a#cs))" by simp
with False ‹cs ≠ []› show ?thesis by(simp add:targetnodes_def)
qed
next
case (slpa_Return cs a as Q p f c' cs')
note IH = ‹⟦cs' ≠ []; upd_cs cs' as = [];
∀xs ys. as = xs@ys ∧ ys ≠ [] ⟶ upd_cs cs' xs ≠ []⟧
⟹ last as ∈ get_return_edges (last cs')›
show ?case
proof(cases "as = []")
case True
with ‹kind a = Q↩⇘p⇙f› ‹cs = c'#cs'› ‹upd_cs cs (a#as) = []›
have "cs' = []" by simp
with ‹cs = c'#cs'› ‹a ∈ get_return_edges c'› True
show ?thesis by simp
next
case False
from ‹kind a = Q↩⇘p⇙f› ‹cs = c'#cs'› ‹upd_cs cs (a#as) = []›
have "upd_cs cs' as = []" by simp
show ?thesis
proof(cases "cs' = []")
case True
with ‹cs = c'#cs'› ‹kind a = Q↩⇘p⇙f› have "upd_cs cs [a] = []" by simp
with ‹∀xs ys. a#as = xs@ys ∧ ys ≠ [] ⟶ upd_cs cs xs ≠ []› False have False
apply(erule_tac x="[a]" in allE) by fastforce
thus ?thesis by simp
next
case False
from ‹∀xs ys. a#as = xs@ys ∧ ys ≠ [] ⟶ upd_cs cs xs ≠ []›
‹kind a = Q↩⇘p⇙f› ‹cs = c'#cs'›
have "∀xs ys. as = xs@ys ∧ ys ≠ [] ⟶ upd_cs cs' xs ≠ []"
by(clarsimp,erule_tac x="a#xs" in allE,simp)
from IH[OF False ‹upd_cs cs' as = []› this]
have "last as ∈ get_return_edges (last cs')" .
with ‹as ≠ []› False ‹cs = c'#cs'› show ?thesis by(simp add:targetnodes_def)
qed
qed
qed
lemma slpa_callstack_length:
assumes "same_level_path_aux cs as" and "length cs = length cfsx"
obtains cfx cfsx' where "transfers (kinds as) (cfsx@cf#cfs) = cfsx'@cfx#cfs"
and "transfers (kinds as) (cfsx@cf#cfs') = cfsx'@cfx#cfs'"
and "length cfsx' = length (upd_cs cs as)"
proof(atomize_elim)
from assms show "∃cfsx' cfx. transfers (kinds as) (cfsx@cf#cfs) = cfsx'@cfx#cfs ∧
transfers (kinds as) (cfsx@cf#cfs') = cfsx'@cfx#cfs' ∧
length cfsx' = length (upd_cs cs as)"
proof(induct arbitrary:cfsx cf rule:slpa_induct)
case (slpa_empty cs) thus ?case by(simp add:kinds_def)
next
case (slpa_intra cs a as)
note IH = ‹⋀cfsx cf. length cs = length cfsx ⟹
∃cfsx' cfx. transfers (kinds as) (cfsx@cf#cfs) = cfsx'@cfx#cfs ∧
transfers (kinds as) (cfsx@cf#cfs') = cfsx'@cfx#cfs' ∧
length cfsx' = length (upd_cs cs as)›
from ‹intra_kind (kind a)›
have "length (upd_cs cs (a#as)) = length (upd_cs cs as)"
by(fastforce simp:intra_kind_def)
show ?case
proof(cases cfsx)
case Nil
with ‹length cs = length cfsx› have "length cs = length []" by simp
from Nil ‹intra_kind (kind a)›
obtain cfx where transfer:"transfer (kind a) (cfsx@cf#cfs) = []@cfx#cfs"
"transfer (kind a) (cfsx@cf#cfs') = []@cfx#cfs'"
by(cases "kind a",auto simp:kinds_def intra_kind_def)
from IH[OF ‹length cs = length []›] obtain cfsx' cfx'
where "transfers (kinds as) ([]@cfx#cfs) = cfsx'@cfx'#cfs"
and "transfers (kinds as) ([]@cfx#cfs') = cfsx'@cfx'#cfs'"
and "length cfsx' = length (upd_cs cs as)" by blast
with ‹length (upd_cs cs (a#as)) = length (upd_cs cs as)› transfer
show ?thesis by(fastforce simp:kinds_def)
next
case (Cons x xs)
with ‹intra_kind (kind a)› obtain cfx'
where transfer:"transfer (kind a) (cfsx@cf#cfs) = (cfx'#xs)@cf#cfs"
"transfer (kind a) (cfsx@cf#cfs') = (cfx'#xs)@cf#cfs'"
by(cases "kind a",auto simp:kinds_def intra_kind_def)
from ‹length cs = length cfsx› Cons have "length cs = length (cfx'#xs)"
by simp
from IH[OF this] obtain cfs'' cf''
where "transfers (kinds as) ((cfx'#xs)@cf#cfs) = cfs''@cf''#cfs"
and "transfers (kinds as) ((cfx'#xs)@cf#cfs') = cfs''@cf''#cfs'"
and "length cfs'' = length (upd_cs cs as)" by blast
with ‹length (upd_cs cs (a#as)) = length (upd_cs cs as)› transfer
show ?thesis by(fastforce simp:kinds_def)
qed
next
case (slpa_Call cs a as Q r p fs)
note IH = ‹⋀cfsx cf. length (a#cs) = length cfsx ⟹
∃cfsx' cfx. transfers (kinds as) (cfsx@cf#cfs) = cfsx'@cfx#cfs ∧
transfers (kinds as) (cfsx@cf#cfs') = cfsx'@cfx#cfs' ∧
length cfsx' = length (upd_cs (a#cs) as)›
from ‹kind a = Q:r↪⇘p⇙fs›
obtain cfx where transfer:"transfer (kind a) (cfsx@cf#cfs) = (cfx#cfsx)@cf#cfs"
"transfer (kind a) (cfsx@cf#cfs') = (cfx#cfsx)@cf#cfs'"
by(cases cfsx) auto
from ‹length cs = length cfsx› have "length (a#cs) = length (cfx#cfsx)"
by simp
from IH[OF this] obtain cfsx' cfx'
where "transfers (kinds as) ((cfx#cfsx)@cf#cfs) = cfsx'@cfx'#cfs"
and "transfers (kinds as) ((cfx#cfsx)@cf#cfs') = cfsx'@cfx'#cfs'"
and "length cfsx' = length (upd_cs (a#cs) as)" by blast
with ‹kind a = Q:r↪⇘p⇙fs› transfer show ?case by(fastforce simp:kinds_def)
next
case (slpa_Return cs a as Q p f c' cs')
note IH = ‹⋀cfsx cf. length cs' = length cfsx ⟹
∃cfsx' cfx. transfers (kinds as) (cfsx@cf#cfs) = cfsx'@cfx#cfs ∧
transfers (kinds as) (cfsx@cf#cfs') = cfsx'@cfx#cfs' ∧
length cfsx' = length (upd_cs cs' as)›
from ‹kind a = Q↩⇘p⇙f› ‹cs = c'#cs'›
have "length (upd_cs cs (a#as)) = length (upd_cs cs' as)" by simp
show ?case
proof(cases cs')
case Nil
with ‹cs = c'#cs'› ‹length cs = length cfsx› obtain cfx
where [simp]:"cfsx = [cfx]" by(cases cfsx) auto
with ‹kind a = Q↩⇘p⇙f› obtain cf'
where transfer:"transfer (kind a) (cfsx@cf#cfs) = []@cf'#cfs"
"transfer (kind a) (cfsx@cf#cfs') = []@cf'#cfs'"
by fastforce
from Nil have "length cs' = length []" by simp
from IH[OF this] obtain cfsx' cfx'
where "transfers (kinds as) ([]@cf'#cfs) = cfsx'@cfx'#cfs"
and "transfers (kinds as) ([]@cf'#cfs') = cfsx'@cfx'#cfs'"
and "length cfsx' = length (upd_cs cs' as)" by blast
with ‹length (upd_cs cs (a#as)) = length (upd_cs cs' as)› transfer
show ?thesis by(fastforce simp:kinds_def)
next
case (Cons cx csx)
with ‹cs = c'#cs'› ‹length cs = length cfsx› obtain x x' xs
where [simp]:"cfsx = x#x'#xs" and "length xs = length csx"
by(cases cfsx,auto,case_tac list,fastforce+)
with ‹kind a = Q↩⇘p⇙f› obtain cf'
where transfer:"transfer (kind a) ((x#x'#xs)@cf#cfs) = (cf'#xs)@cf#cfs"
"transfer (kind a) ((x#x'#xs)@cf#cfs') = (cf'#xs)@cf#cfs'"
by fastforce
from ‹cs = c'#cs'› ‹length cs = length cfsx› have "length cs' = length (cf'#xs)"
by simp
from IH[OF this] obtain cfsx' cfx
where "transfers (kinds as) ((cf'#xs)@cf#cfs) = cfsx'@cfx#cfs"
and "transfers (kinds as) ((cf'#xs)@cf#cfs') = cfsx'@cfx#cfs'"
and "length cfsx' = length (upd_cs cs' as)" by blast
with ‹length (upd_cs cs (a#as)) = length (upd_cs cs' as)› transfer
show ?thesis by(fastforce simp:kinds_def)
qed
qed
qed
lemma slpa_snoc_intra:
"⟦same_level_path_aux cs as; intra_kind (kind a)⟧
⟹ same_level_path_aux cs (as@[a])"
by(induct rule:slpa_induct,auto simp:intra_kind_def)
lemma slpa_snoc_Call:
"⟦same_level_path_aux cs as; kind a = Q:r↪⇘p⇙fs⟧
⟹ same_level_path_aux cs (as@[a])"
by(induct rule:slpa_induct,auto simp:intra_kind_def)
lemma vpa_Main_slpa:
"⟦valid_path_aux cs as; m -as→* m'; as ≠ [];
valid_call_list cs m; get_proc m' = Main;
get_proc (case cs of [] ⇒ m | _ ⇒ sourcenode (last cs)) = Main⟧
⟹ same_level_path_aux cs as ∧ upd_cs cs as = []"
proof(induct arbitrary:m rule:vpa_induct)
case (vpa_empty cs) thus ?case by simp
next
case (vpa_intra cs a as)
note IH = ‹⋀m. ⟦m -as→* m'; as ≠ []; valid_call_list cs m; get_proc m' = Main;
get_proc (case cs of [] ⇒ m | a # list ⇒ sourcenode (last cs)) = Main⟧
⟹ same_level_path_aux cs as ∧ upd_cs cs as = []›
from ‹m -a # as→* m'› have "sourcenode a = m" and "valid_edge a"
and "targetnode a -as→* m'" by(auto elim:path_split_Cons)
from ‹valid_edge a› ‹intra_kind (kind a)›
have "get_proc (sourcenode a) = get_proc (targetnode a)" by(rule get_proc_intra)
show ?case
proof(cases "as = []")
case True
with ‹targetnode a -as→* m'› have "targetnode a = m'" by fastforce
with ‹get_proc (sourcenode a) = get_proc (targetnode a)›
‹sourcenode a = m› ‹get_proc m' = Main›
have "get_proc m = Main" by simp
have "cs = []"
proof(cases cs)
case Cons
with ‹valid_call_list cs m›
obtain c Q r p fs where "valid_edge c" and "kind c = Q:r↪⇘get_proc m⇙fs"
by(auto simp:valid_call_list_def,erule_tac x="[]" in allE,
auto simp:sourcenodes_def)
with ‹get_proc m = Main› have "kind c = Q:r↪⇘Main⇙fs" by simp
with ‹valid_edge c› have False by(rule Main_no_call_target)
thus ?thesis by simp
qed simp
with True ‹intra_kind (kind a)› show ?thesis by(fastforce simp:intra_kind_def)
next
case False
from ‹valid_call_list cs m› ‹sourcenode a = m›
‹get_proc (sourcenode a) = get_proc (targetnode a)›
have "valid_call_list cs (targetnode a)"
apply(clarsimp simp:valid_call_list_def)
apply(erule_tac x="cs'" in allE)
apply(erule_tac x="c" in allE)
by(auto split:list.split)
from ‹get_proc (case cs of [] ⇒ m | _ ⇒ sourcenode (last cs)) = Main›
‹sourcenode a = m› ‹get_proc (sourcenode a) = get_proc (targetnode a)›
have "get_proc (case cs of [] ⇒ targetnode a | _ ⇒ sourcenode (last cs)) = Main"
by(cases cs) auto
from IH[OF ‹targetnode a -as→* m'› False ‹valid_call_list cs (targetnode a)›
‹get_proc m' = Main› this]
have "same_level_path_aux cs as ∧ upd_cs cs as = []" .
with ‹intra_kind (kind a)› show ?thesis by(fastforce simp:intra_kind_def)
qed
next
case (vpa_Call cs a as Q r p fs)
note IH = ‹⋀m. ⟦m -as→* m'; as ≠ []; valid_call_list (a # cs) m;
get_proc m' = Main;
get_proc (case a # cs of [] ⇒ m | _ ⇒ sourcenode (last (a # cs))) = Main⟧
⟹ same_level_path_aux (a # cs) as ∧ upd_cs (a # cs) as = []›
from ‹m -a # as→* m'› have "sourcenode a = m" and "valid_edge a"
and "targetnode a -as→* m'" by(auto elim:path_split_Cons)
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› have "get_proc (targetnode a) = p"
by(rule get_proc_call)
show ?case
proof(cases "as = []")
case True
with ‹targetnode a -as→* m'› have "targetnode a = m'" by fastforce
with ‹get_proc (targetnode a) = p› ‹get_proc m' = Main› ‹kind a = Q:r↪⇘p⇙fs›
have "kind a = Q:r↪⇘Main⇙fs" by simp
with ‹valid_edge a› have False by(rule Main_no_call_target)
thus ?thesis by simp
next
case False
from ‹get_proc (targetnode a) = p› ‹valid_call_list cs m› ‹valid_edge a›
‹kind a = Q:r↪⇘p⇙fs› ‹sourcenode a = m›
have "valid_call_list (a # cs) (targetnode a)"
apply(clarsimp simp:valid_call_list_def)
apply(case_tac cs') apply auto
apply(erule_tac x="list" in allE)
by(case_tac list)(auto simp:sourcenodes_def)
from ‹get_proc (case cs of [] ⇒ m | _ ⇒ sourcenode (last cs)) = Main›
‹sourcenode a = m›
have "get_proc (case a # cs of [] ⇒ targetnode a
| _ ⇒ sourcenode (last (a # cs))) = Main"
by(cases cs) auto
from IH[OF ‹targetnode a -as→* m'› False ‹valid_call_list (a#cs) (targetnode a)›
‹get_proc m' = Main› this]
have "same_level_path_aux (a # cs) as ∧ upd_cs (a # cs) as = []" .
with ‹kind a = Q:r↪⇘p⇙fs› show ?thesis by simp
qed
next
case (vpa_ReturnEmpty cs a as Q p f)
note IH = ‹⋀m. ⟦m -as→* m'; as ≠ []; valid_call_list [] m; get_proc m' = Main;
get_proc (case [] of [] ⇒ m | a # list ⇒ sourcenode (last [])) = Main⟧
⟹ same_level_path_aux [] as ∧ upd_cs [] as = []›
from ‹m -a # as→* m'› have "sourcenode a = m" and "valid_edge a"
and "targetnode a -as→* m'" by(auto elim:path_split_Cons)
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f› have "get_proc (sourcenode a) = p"
by(rule get_proc_return)
from ‹get_proc (case cs of [] ⇒ m | a # list ⇒ sourcenode (last cs)) = Main›
‹cs = []›
have "get_proc m = Main" by simp
with ‹sourcenode a = m› ‹get_proc (sourcenode a) = p› have "p = Main" by simp
with ‹kind a = Q↩⇘p⇙f› have "kind a = Q↩⇘Main⇙f" by simp
with ‹valid_edge a› have False by(rule Main_no_return_source)
thus ?case by simp
next
case (vpa_ReturnCons cs a as Q p f c' cs')
note IH = ‹⋀m. ⟦m -as→* m'; as ≠ []; valid_call_list cs' m; get_proc m' = Main;
get_proc (case cs' of [] ⇒ m | a # list ⇒ sourcenode (last cs')) = Main⟧
⟹ same_level_path_aux cs' as ∧ upd_cs cs' as = []›
from ‹m -a # as→* m'› have "sourcenode a = m" and "valid_edge a"
and "targetnode a -as→* m'" by(auto elim:path_split_Cons)
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f› have "get_proc (sourcenode a) = p"
by(rule get_proc_return)
from ‹valid_call_list cs m› ‹cs = c' # cs'›
have "valid_edge c'"
by(auto simp:valid_call_list_def,erule_tac x="[]" in allE,auto)
from ‹valid_edge c'› ‹a ∈ get_return_edges c'›
have "get_proc (sourcenode c') = get_proc (targetnode a)"
by(rule get_proc_get_return_edge)
show ?case
proof(cases "as = []")
case True
with ‹targetnode a -as→* m'› have "targetnode a = m'" by fastforce
with ‹get_proc m' = Main› have "get_proc (targetnode a) = Main" by simp
from ‹get_proc (sourcenode c') = get_proc (targetnode a)›
‹get_proc (targetnode a) = Main›
have "get_proc (sourcenode c') = Main" by simp
have "cs' = []"
proof(cases cs')
case (Cons cx csx)
with ‹cs = c' # cs'› ‹valid_call_list cs m›
obtain Qx rx fsx where "valid_edge cx"
and "kind cx = Qx:rx↪⇘get_proc (sourcenode c')⇙fsx"
by(auto simp:valid_call_list_def,erule_tac x="[c']" in allE,
auto simp:sourcenodes_def)
with ‹get_proc (sourcenode c') = Main› have "kind cx = Qx:rx↪⇘Main⇙fsx" by simp
with ‹valid_edge cx› have False by(rule Main_no_call_target)
thus ?thesis by simp
qed simp
with True ‹cs = c' # cs'› ‹a ∈ get_return_edges c'› ‹kind a = Q↩⇘p⇙f›
show ?thesis by simp
next
case False
from ‹valid_call_list cs m› ‹cs = c' # cs'›
‹get_proc (sourcenode c') = get_proc (targetnode a)›
have "valid_call_list cs' (targetnode a)"
apply(clarsimp simp:valid_call_list_def)
apply(hypsubst_thin)
apply(erule_tac x="c' # cs'" in allE)
by(case_tac cs')(auto simp:sourcenodes_def)
from ‹get_proc (case cs of [] ⇒ m | a # list ⇒ sourcenode (last cs)) = Main›
‹cs = c' # cs'› ‹get_proc (sourcenode c') = get_proc (targetnode a)›
have "get_proc (case cs' of [] ⇒ targetnode a
| _ ⇒ sourcenode (last cs')) = Main"
by(cases cs') auto
from IH[OF ‹targetnode a -as→* m'› False ‹valid_call_list cs' (targetnode a)›
‹get_proc m' = Main› this]
have "same_level_path_aux cs' as ∧ upd_cs cs' as = []" .
with ‹kind a = Q↩⇘p⇙f› ‹cs = c' # cs'› ‹a ∈ get_return_edges c'›
show ?thesis by simp
qed
qed
definition same_level_path :: "'edge list ⇒ bool"
where "same_level_path as ≡ same_level_path_aux [] as ∧ upd_cs [] as = []"
lemma same_level_path_valid_path:
"same_level_path as ⟹ valid_path as"
by(fastforce intro:same_level_path_aux_valid_path_aux
simp:same_level_path_def valid_path_def)
lemma same_level_path_Append:
"⟦same_level_path as; same_level_path as'⟧ ⟹ same_level_path (as@as')"
by(fastforce elim:same_level_path_aux_Append upd_cs_Append simp:same_level_path_def)
lemma same_level_path_number_Calls_eq_number_Returns:
"⟦same_level_path as; ∀a ∈ set as. valid_edge a⟧ ⟹
length [a←as. ∃Q r p fs. kind a = Q:r↪⇘p⇙fs] = length [a←as. ∃Q p f. kind a = Q↩⇘p⇙f]"
by(fastforce dest:slpa_number_Calls_eq_number_Returns simp:same_level_path_def)
lemma same_level_path_valid_path_Append:
"⟦same_level_path as; valid_path as'⟧ ⟹ valid_path (as@as')"
by(fastforce intro:valid_path_aux_Append elim:same_level_path_aux_valid_path_aux
simp:valid_path_def same_level_path_def)
lemma valid_path_same_level_path_Append:
"⟦valid_path as; same_level_path as'⟧ ⟹ valid_path (as@as')"
apply(auto simp:valid_path_def same_level_path_def)
apply(erule valid_path_aux_Append)
by(fastforce intro!:same_level_path_aux_valid_path_aux
dest:same_level_path_aux_callstack_Append)
lemma intras_same_level_path:
assumes "∀a ∈ set as. intra_kind(kind a)" shows "same_level_path as"
proof -
from ‹∀a ∈ set as. intra_kind(kind a)› have "same_level_path_aux [] as"
by(induct as)(auto simp:intra_kind_def)
moreover
from ‹∀a ∈ set as. intra_kind(kind a)› have "upd_cs [] as = []"
by(induct as)(auto simp:intra_kind_def)
ultimately show ?thesis by(simp add:same_level_path_def)
qed
definition same_level_path' :: "'node ⇒ 'edge list ⇒ 'node ⇒ bool"
("_ -_→⇘sl⇙* _" [51,0,0] 80)
where slp_def:"n -as→⇘sl⇙* n' ≡ n -as→* n' ∧ same_level_path as"
lemma slp_vp: "n -as→⇘sl⇙* n' ⟹ n -as→⇩√* n'"
by(fastforce intro:same_level_path_valid_path simp:slp_def vp_def)
lemma intra_path_slp: "n -as→⇩ι* n' ⟹ n -as→⇘sl⇙* n'"
by(fastforce intro:intras_same_level_path simp:slp_def intra_path_def)
lemma slp_Append:
"⟦n -as→⇘sl⇙* n''; n'' -as'→⇘sl⇙* n'⟧ ⟹ n -as@as'→⇘sl⇙* n'"
by(fastforce simp:slp_def intro:path_Append same_level_path_Append)
lemma slp_vp_Append:
"⟦n -as→⇘sl⇙* n''; n'' -as'→⇩√* n'⟧ ⟹ n -as@as'→⇩√* n'"
by(fastforce simp:slp_def vp_def intro:path_Append same_level_path_valid_path_Append)
lemma vp_slp_Append:
"⟦n -as→⇩√* n''; n'' -as'→⇘sl⇙* n'⟧ ⟹ n -as@as'→⇩√* n'"
by(fastforce simp:slp_def vp_def intro:path_Append valid_path_same_level_path_Append)
lemma slp_get_proc:
"n -as→⇘sl⇙* n' ⟹ get_proc n = get_proc n'"
by(fastforce dest:slpa_get_proc simp:same_level_path_def slp_def)
lemma same_level_path_inner_path:
assumes "n -as→⇘sl⇙* n'"
obtains as' where "n -as'→⇩ι* n'" and "set(sourcenodes as') ⊆ set(sourcenodes as)"
proof(atomize_elim)
from ‹n -as→⇘sl⇙* n'› have "n -as→* n'" and "same_level_path as"
by(simp_all add:slp_def)
from ‹same_level_path as› have "same_level_path_aux [] as" and "upd_cs [] as = []"
by(simp_all add:same_level_path_def)
from ‹n -as→* n'› ‹same_level_path_aux [] as› ‹upd_cs [] as = []›
show "∃as'. n -as'→⇩ι* n' ∧ set(sourcenodes as') ⊆ set(sourcenodes as)"
proof(induct as arbitrary:n rule:length_induct)
fix as n
assume IH:"∀as''. length as'' < length as ⟶
(∀n''. n'' -as''→* n' ⟶ same_level_path_aux [] as'' ⟶
upd_cs [] as'' = [] ⟶
(∃as'. n'' -as'→⇩ι* n' ∧ set (sourcenodes as') ⊆ set (sourcenodes as'')))"
and "n -as→* n'" and "same_level_path_aux [] as" and "upd_cs [] as = []"
show "∃as'. n -as'→⇩ι* n' ∧ set (sourcenodes as') ⊆ set (sourcenodes as)"
proof(cases as)
case Nil
with ‹n -as→* n'› show ?thesis by(fastforce simp:intra_path_def)
next
case (Cons a' as')
with ‹n -as→* n'› Cons have "n = sourcenode a'" and "valid_edge a'"
and "targetnode a' -as'→* n'"
by(auto intro:path_split_Cons)
show ?thesis
proof(cases "kind a'" rule:edge_kind_cases)
case Intra
with Cons ‹same_level_path_aux [] as› have "same_level_path_aux [] as'"
by(fastforce simp:intra_kind_def)
moreover
from Intra Cons ‹upd_cs [] as = []› have "upd_cs [] as' = []"
by(fastforce simp:intra_kind_def)
ultimately obtain as'' where "targetnode a' -as''→⇩ι* n'"
and "set (sourcenodes as'') ⊆ set (sourcenodes as')"
using IH Cons ‹targetnode a' -as'→* n'›
by(erule_tac x="as'" in allE) auto
from ‹n = sourcenode a'› ‹valid_edge a'› Intra ‹targetnode a' -as''→⇩ι* n'›
have "n -a'#as''→⇩ι* n'" by(fastforce intro:Cons_path simp:intra_path_def)
with ‹set (sourcenodes as'') ⊆ set (sourcenodes as')› Cons show ?thesis
by(rule_tac x="a'#as''" in exI,auto simp:sourcenodes_def)
next
case (Call Q p f)
with Cons ‹same_level_path_aux [] as›
have "same_level_path_aux [a'] as'" by simp
from Call Cons ‹upd_cs [] as = []› have "upd_cs [a'] as' = []" by simp
hence "as' ≠ []" by fastforce
with ‹upd_cs [a'] as' = []› obtain xs ys where "as' = xs@ys" and "xs ≠ []"
and "upd_cs [a'] xs = []" and "upd_cs [] ys = []"
and "∀xs' ys'. xs = xs'@ys' ∧ ys' ≠ [] ⟶ upd_cs [a'] xs' ≠ []"
by -(erule upd_cs_empty_split,auto)
from ‹same_level_path_aux [a'] as'› ‹as' = xs@ys› ‹upd_cs [a'] xs = []›
have "same_level_path_aux [a'] xs" and "same_level_path_aux [] ys"
by(auto intro:slpa_split)
from ‹same_level_path_aux [a'] xs› ‹upd_cs [a'] xs = []›
‹∀xs' ys'. xs = xs'@ys' ∧ ys' ≠ [] ⟶ upd_cs [a'] xs' ≠ []›
have "last xs ∈ get_return_edges (last [a'])"
by(fastforce intro!:slpa_get_return_edges)
with ‹valid_edge a'› Call
obtain a where "valid_edge a" and "sourcenode a = sourcenode a'"
and "targetnode a = targetnode (last xs)" and "kind a = (λcf. False)⇩√"
by -(drule call_return_node_edge,auto)
from ‹targetnode a = targetnode (last xs)› ‹xs ≠ []›
have "targetnode a = targetnode (last (a'#xs))" by simp
from ‹as' = xs@ys› ‹xs ≠ []› Cons have "length ys < length as" by simp
from ‹targetnode a' -as'→* n'› ‹as' = xs@ys› ‹xs ≠ []›
have "targetnode (last (a'#xs)) -ys→* n'"
by(cases xs rule:rev_cases,auto dest:path_split)
with IH ‹length ys < length as› ‹same_level_path_aux [] ys›
‹upd_cs [] ys = []›
obtain as'' where "targetnode (last (a'#xs)) -as''→⇩ι* n'"
and "set(sourcenodes as'') ⊆ set(sourcenodes ys)"
apply(erule_tac x="ys" in allE) apply clarsimp
apply(erule_tac x="targetnode (last (a'#xs))" in allE)
by clarsimp
from ‹sourcenode a = sourcenode a'› ‹n = sourcenode a'›
‹targetnode a = targetnode (last (a'#xs))› ‹valid_edge a›
‹kind a = (λcf. False)⇩√› ‹targetnode (last (a'#xs)) -as''→⇩ι* n'›
have "n -a#as''→⇩ι* n'"
by(fastforce intro:Cons_path simp:intra_path_def intra_kind_def)
moreover
from ‹set(sourcenodes as'') ⊆ set(sourcenodes ys)› Cons ‹as' = xs@ys›
‹sourcenode a = sourcenode a'›
have "set(sourcenodes (a#as'')) ⊆ set(sourcenodes as)"
by(auto simp:sourcenodes_def)
ultimately show ?thesis by blast
next
case (Return Q p f)
with Cons ‹same_level_path_aux [] as› have False by simp
thus ?thesis by simp
qed
qed
qed
qed
lemma slp_callstack_length_equal:
assumes "n -as→⇘sl⇙* n'" obtains cf' where "transfers (kinds as) (cf#cfs) = cf'#cfs"
and "transfers (kinds as) (cf#cfs') = cf'#cfs'"
proof(atomize_elim)
from ‹n -as→⇘sl⇙* n'› have "same_level_path_aux [] as" and "upd_cs [] as = []"
by(simp_all add:slp_def same_level_path_def)
then obtain cfx cfsx where "transfers (kinds as) (cf#cfs) = cfsx@cfx#cfs"
and "transfers (kinds as) (cf#cfs') = cfsx@cfx#cfs'"
and "length cfsx = length (upd_cs [] as)"
by(fastforce elim:slpa_callstack_length)
with ‹upd_cs [] as = []› have "cfsx = []" by(cases cfsx) auto
with ‹transfers (kinds as) (cf#cfs) = cfsx@cfx#cfs›
‹transfers (kinds as) (cf#cfs') = cfsx@cfx#cfs'›
show "∃cf'. transfers (kinds as) (cf#cfs) = cf'#cfs ∧
transfers (kinds as) (cf#cfs') = cf'#cfs'" by fastforce
qed
lemma slp_cases [consumes 1,case_names intra_path return_intra_path]:
assumes "m -as→⇘sl⇙* m'"
obtains "m -as→⇩ι* m'"
| as' a as'' Q p f where "as = as'@a#as''" and "kind a = Q↩⇘p⇙f"
and "m -as'@[a]→⇘sl⇙* targetnode a" and "targetnode a -as''→⇩ι* m'"
proof(atomize_elim)
from ‹m -as→⇘sl⇙* m'› have "m -as→* m'" and "same_level_path_aux [] as"
and "upd_cs [] as = []" by(simp_all add:slp_def same_level_path_def)
from ‹m -as→* m'› have "∀a ∈ set as. valid_edge a" by(rule path_valid_edges)
have "∀a ∈ set []. valid_edge a" by simp
with ‹same_level_path_aux [] as› ‹upd_cs [] as = []› ‹∀a ∈ set []. valid_edge a›
‹∀a ∈ set as. valid_edge a›
show "m -as→⇩ι* m' ∨
(∃as' a as'' Q p f. as = as' @ a # as'' ∧ kind a = Q↩⇘p⇙f ∧
m -as' @ [a]→⇘sl⇙* targetnode a ∧ targetnode a -as''→⇩ι* m')"
proof(cases rule:slpa_cases)
case intra_path
with ‹m -as→* m'› have "m -as→⇩ι* m'" by(simp add:intra_path_def)
thus ?thesis by blast
next
case (return_intra_path as' a as'' Q p f c' cs')
from ‹m -as→* m'› ‹as = as' @ a # as''›
have "m -as'→* sourcenode a" and "valid_edge a" and "targetnode a -as''→* m'"
by(auto intro:path_split)
from ‹m -as'→* sourcenode a› ‹valid_edge a›
have "m -as'@[a]→* targetnode a" by(fastforce intro:path_Append path_edge)
with ‹same_level_path_aux [] as'› ‹upd_cs [] as' = c' # cs'› ‹kind a = Q↩⇘p⇙f›
‹a ∈ get_return_edges c'›
have "same_level_path_aux [] (as'@[a])"
by(fastforce intro:same_level_path_aux_Append)
with ‹upd_cs [] (as' @ [a]) = []› ‹m -as'@[a]→* targetnode a›
have "m -as'@[a]→⇘sl⇙* targetnode a" by(simp add:slp_def same_level_path_def)
moreover
from ‹∀a∈set as''. intra_kind (kind a)› ‹targetnode a -as''→* m'›
have "targetnode a -as''→⇩ι* m'" by(simp add:intra_path_def)
ultimately show ?thesis using ‹as = as' @ a # as''› ‹kind a = Q↩⇘p⇙f› by blast
qed
qed
function same_level_path_rev_aux :: "'edge list ⇒ 'edge list ⇒ bool"
where "same_level_path_rev_aux cs [] ⟷ True"
| "same_level_path_rev_aux cs (as@[a]) ⟷
(case (kind a) of Q↩⇘p⇙f ⇒ same_level_path_rev_aux (a#cs) as
| Q:r↪⇘p⇙fs ⇒ case cs of [] ⇒ False
| c'#cs' ⇒ c' ∈ get_return_edges a ∧
same_level_path_rev_aux cs' as
| _ ⇒ same_level_path_rev_aux cs as)"
by auto(case_tac b rule:rev_cases,auto)
termination by lexicographic_order
lemma slpra_induct [consumes 1,case_names slpra_empty slpra_intra slpra_Return
slpra_Call]:
assumes major: "same_level_path_rev_aux xs ys"
and rules: "⋀cs. P cs []"
"⋀cs a as. ⟦intra_kind(kind a); same_level_path_rev_aux cs as; P cs as⟧
⟹ P cs (as@[a])"
"⋀cs a as Q p f. ⟦kind a = Q↩⇘p⇙f; same_level_path_rev_aux (a#cs) as; P (a#cs) as⟧
⟹ P cs (as@[a])"
"⋀cs a as Q r p fs c' cs'. ⟦kind a = Q:r↪⇘p⇙fs; cs = c'#cs';
same_level_path_rev_aux cs' as; c' ∈ get_return_edges a; P cs' as⟧
⟹ P cs (as@[a])"
shows "P xs ys"
using major
apply(induct ys arbitrary: xs rule:rev_induct)
by(auto intro:rules split:edge_kind.split_asm list.split_asm simp:intra_kind_def)
lemma same_level_path_rev_aux_Append:
"⟦same_level_path_rev_aux cs as'; same_level_path_rev_aux (upd_rev_cs cs as') as⟧
⟹ same_level_path_rev_aux cs (as@as')"
by(induct rule:slpra_induct,
auto simp:intra_kind_def simp del:append_assoc simp:append_assoc[THEN sym])
lemma slpra_to_slpa:
"⟦same_level_path_rev_aux cs as; upd_rev_cs cs as = []; n -as→* n';
valid_return_list cs n'⟧
⟹ same_level_path_aux [] as ∧ same_level_path_aux (upd_cs [] as) cs ∧
upd_cs (upd_cs [] as) cs = []"
proof(induct arbitrary:n' rule:slpra_induct)
case slpra_empty thus ?case by simp
next
case (slpra_intra cs a as)
note IH = ‹⋀n'. ⟦upd_rev_cs cs as = []; n -as→* n'; valid_return_list cs n'⟧
⟹ same_level_path_aux [] as ∧ same_level_path_aux (upd_cs [] as) cs ∧
upd_cs (upd_cs [] as) cs = []›
from ‹n -as@[a]→* n'› have "n -as→* sourcenode a" and "valid_edge a"
and "n' = targetnode a" by(auto intro:path_split_snoc)
from ‹valid_edge a› ‹intra_kind (kind a)›
have "get_proc (sourcenode a) = get_proc (targetnode a)"
by(rule get_proc_intra)
with ‹valid_return_list cs n'› ‹n' = targetnode a›
have "valid_return_list cs (sourcenode a)"
apply(clarsimp simp:valid_return_list_def)
apply(erule_tac x="cs'" in allE) apply clarsimp
by(case_tac cs')(auto simp:targetnodes_def)
from ‹upd_rev_cs cs (as@[a]) = []› ‹intra_kind (kind a)›
have "upd_rev_cs cs as = []" by(fastforce simp:intra_kind_def)
from ‹valid_edge a› ‹intra_kind (kind a)›
have "get_proc (sourcenode a) = get_proc (targetnode a)" by(rule get_proc_intra)
from IH[OF ‹upd_rev_cs cs as = []› ‹n -as→* sourcenode a›
‹valid_return_list cs (sourcenode a)›]
have "same_level_path_aux [] as"
and "same_level_path_aux (upd_cs [] as) cs"
and "upd_cs (upd_cs [] as) cs = []" by simp_all
from ‹same_level_path_aux [] as› ‹intra_kind (kind a)›
have "same_level_path_aux [] (as@[a])" by(rule slpa_snoc_intra)
from ‹intra_kind (kind a)›
have "upd_cs [] (as@[a]) = upd_cs [] as"
by(fastforce simp:upd_cs_Append intra_kind_def)
moreover
from ‹same_level_path_aux [] as› ‹intra_kind (kind a)›
have "same_level_path_aux [] (as@[a])" by(rule slpa_snoc_intra)
ultimately show ?case using ‹same_level_path_aux (upd_cs [] as) cs›
‹upd_cs (upd_cs [] as) cs = []›
by simp
next
case (slpra_Return cs a as Q p f)
note IH = ‹⋀n' n''. ⟦upd_rev_cs (a#cs) as = []; n -as→* n';
valid_return_list (a#cs) n'⟧
⟹ same_level_path_aux [] as ∧
same_level_path_aux (upd_cs [] as) (a#cs) ∧
upd_cs (upd_cs [] as) (a#cs) = []›
from ‹n -as@[a]→* n'› have "n -as→* sourcenode a" and "valid_edge a"
and "n' = targetnode a" by(auto intro:path_split_snoc)
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f› have "p = get_proc (sourcenode a)"
by(rule get_proc_return[THEN sym])
from ‹valid_return_list cs n'› ‹n' = targetnode a›
have "valid_return_list cs (targetnode a)" by simp
with ‹valid_edge a› ‹kind a = Q↩⇘p⇙f› ‹p = get_proc (sourcenode a)›
have "valid_return_list (a#cs) (sourcenode a)"
apply(clarsimp simp:valid_return_list_def)
apply(case_tac cs') apply auto
apply(erule_tac x="list" in allE) apply clarsimp
by(case_tac list,auto simp:targetnodes_def)
from ‹upd_rev_cs cs (as@[a]) = []› ‹kind a = Q↩⇘p⇙f›
have "upd_rev_cs (a#cs) as = []" by simp
from IH[OF this ‹n -as→* sourcenode a› ‹valid_return_list (a#cs) (sourcenode a)›]
have "same_level_path_aux [] as"
and "same_level_path_aux (upd_cs [] as) (a#cs)"
and "upd_cs (upd_cs [] as) (a#cs) = []" by simp_all
show ?case
proof(cases "upd_cs [] as")
case Nil
with ‹kind a = Q↩⇘p⇙f› ‹same_level_path_aux (upd_cs [] as) (a#cs)›
have False by simp
thus ?thesis by simp
next
case (Cons cx csx)
with ‹kind a = Q↩⇘p⇙f› ‹same_level_path_aux (upd_cs [] as) (a#cs)›
obtain Qx fx
where match:"a ∈ get_return_edges cx" "same_level_path_aux csx cs" by auto
from ‹kind a = Q↩⇘p⇙f› Cons have "upd_cs [] (as@[a]) = csx"
by(rule upd_cs_snoc_Return_Cons)
with ‹same_level_path_aux (upd_cs [] as) (a#cs)›
‹kind a = Q↩⇘p⇙f› match
have "same_level_path_aux (upd_cs [] (as@[a])) cs" by simp
from ‹upd_cs [] (as@[a]) = csx› ‹kind a = Q↩⇘p⇙f› Cons
‹upd_cs (upd_cs [] as) (a#cs) = []›
have "upd_cs (upd_cs [] (as@[a])) cs = []" by simp
from Cons ‹kind a = Q↩⇘p⇙f› match
have "same_level_path_aux (upd_cs [] as) [a]" by simp
with ‹same_level_path_aux [] as› have "same_level_path_aux [] (as@[a])"
by(rule same_level_path_aux_Append)
with ‹same_level_path_aux (upd_cs [] (as@[a])) cs›
‹upd_cs (upd_cs [] (as@[a])) cs = []›
show ?thesis by simp
qed
next
case (slpra_Call cs a as Q r p fs cx csx)
note IH = ‹⋀n'. ⟦upd_rev_cs csx as = []; n -as→* n'; valid_return_list csx n'⟧
⟹ same_level_path_aux [] as ∧
same_level_path_aux (upd_cs [] as) csx ∧ upd_cs (upd_cs [] as) csx = []›
note match = ‹cs = cx#csx› ‹cx ∈ get_return_edges a›
from ‹n -as@[a]→* n'› have "n -as→* sourcenode a" and "valid_edge a"
and "n' = targetnode a" by(auto intro:path_split_snoc)
from ‹valid_edge a› match
have "get_proc (sourcenode a) = get_proc (targetnode cx)"
by(fastforce intro:get_proc_get_return_edge)
with ‹valid_return_list cs n'› ‹cs = cx#csx›
have "valid_return_list csx (sourcenode a)"
apply(clarsimp simp:valid_return_list_def)
apply(erule_tac x="cx#cs'" in allE) apply clarsimp
by(case_tac cs',auto simp:targetnodes_def)
from ‹kind a = Q:r↪⇘p⇙fs› match ‹upd_rev_cs cs (as@[a]) = []›
have "upd_rev_cs csx as = []" by simp
from IH[OF this ‹n -as→* sourcenode a› ‹valid_return_list csx (sourcenode a)›]
have "same_level_path_aux [] as"
and "same_level_path_aux (upd_cs [] as) csx" and "upd_cs (upd_cs [] as) csx = []"
by simp_all
from ‹same_level_path_aux [] as› ‹kind a = Q:r↪⇘p⇙fs›
have "same_level_path_aux [] (as@[a])" by(rule slpa_snoc_Call)
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› match obtain Q' f' where "kind cx = Q'↩⇘p⇙f'"
by(fastforce dest!:call_return_edges)
from ‹kind a = Q:r↪⇘p⇙fs› have "upd_cs [] (as@[a]) = a#(upd_cs [] as)"
by(rule upd_cs_snoc_Call)
with ‹same_level_path_aux (upd_cs [] as) csx› ‹kind a = Q:r↪⇘p⇙fs›
‹kind cx = Q'↩⇘p⇙f'› match
have "same_level_path_aux (upd_cs [] (as@[a])) cs" by simp
from ‹upd_cs (upd_cs [] as) csx = []› ‹upd_cs [] (as@[a]) = a#(upd_cs [] as)›
‹kind a = Q:r↪⇘p⇙fs› ‹kind cx = Q'↩⇘p⇙f'› match
have "upd_cs (upd_cs [] (as@[a])) cs = []" by simp
with ‹same_level_path_aux [] (as@[a])›
‹same_level_path_aux (upd_cs [] (as@[a])) cs› show ?case by simp
qed
subsubsection ‹Lemmas on paths with ‹(_Entry_)››
lemma path_Entry_target [dest]:
assumes "n -as→* (_Entry_)"
shows "n = (_Entry_)" and "as = []"
using ‹n -as→* (_Entry_)›
proof(induct n as n'≡"(_Entry_)" rule:path.induct)
case (Cons_path n'' as a n)
from ‹n'' = (_Entry_)› ‹targetnode a = n''› ‹valid_edge a› have False
by -(rule Entry_target,simp_all)
{ case 1
from ‹False› show ?case ..
next
case 2
from ‹False› show ?case ..
}
qed simp_all
lemma Entry_sourcenode_hd:
assumes "n -as→* n'" and "(_Entry_) ∈ set (sourcenodes as)"
shows "n = (_Entry_)" and "(_Entry_) ∉ set (sourcenodes (tl as))"
using ‹n -as→* n'› ‹(_Entry_) ∈ set (sourcenodes as)›
proof(induct rule:path.induct)
case (empty_path n) case 1
thus ?case by(simp add:sourcenodes_def)
next
case (empty_path n) case 2
thus ?case by(simp add:sourcenodes_def)
next
case (Cons_path n'' as n' a n)
note IH1 = ‹(_Entry_) ∈ set(sourcenodes as) ⟹ n'' = (_Entry_)›
note IH2 = ‹(_Entry_) ∈ set(sourcenodes as) ⟹ (_Entry_) ∉ set(sourcenodes(tl as))›
have "(_Entry_) ∉ set (sourcenodes(tl(a#as)))"
proof(rule ccontr)
assume "¬ (_Entry_) ∉ set (sourcenodes (tl (a#as)))"
hence "(_Entry_) ∈ set (sourcenodes as)" by simp
from IH1[OF this] have "n'' = (_Entry_)" by simp
with ‹targetnode a = n''› ‹valid_edge a› show False by -(erule Entry_target,simp)
qed
hence "(_Entry_) ∉ set (sourcenodes(tl(a#as)))" by fastforce
{ case 1
with ‹(_Entry_) ∉ set (sourcenodes(tl(a#as)))› ‹sourcenode a = n›
show ?case by(simp add:sourcenodes_def)
next
case 2
with ‹(_Entry_) ∉ set (sourcenodes(tl(a#as)))› ‹sourcenode a = n›
show ?case by(simp add:sourcenodes_def)
}
qed
lemma Entry_no_inner_return_path:
assumes "(_Entry_) -as@[a]→* n" and "∀a ∈ set as. intra_kind(kind a)"
and "kind a = Q↩⇘p⇙f"
shows "False"
proof -
from ‹(_Entry_) -as@[a]→* n› have "(_Entry_) -as→* sourcenode a"
and "valid_edge a" and "targetnode a = n" by(auto intro:path_split_snoc)
from ‹(_Entry_) -as→* sourcenode a› ‹∀a ∈ set as. intra_kind(kind a)›
have "(_Entry_) -as→⇩ι* sourcenode a" by(simp add:intra_path_def)
hence "get_proc (sourcenode a) = Main"
by(fastforce dest:intra_path_get_procs simp:get_proc_Entry)
with ‹valid_edge a› ‹kind a = Q↩⇘p⇙f› have "p = Main"
by(fastforce dest:get_proc_return)
with ‹valid_edge a› ‹kind a = Q↩⇘p⇙f› show ?thesis
by(fastforce intro:Main_no_return_source)
qed
lemma vpra_no_slpra:
"⟦valid_path_rev_aux cs as; n -as→* n'; valid_return_list cs n'; cs ≠ [];
∀xs ys. as = xs@ys ⟶ (¬ same_level_path_rev_aux cs ys ∨ upd_rev_cs cs ys ≠ [])⟧
⟹ ∃a Q f. valid_edge a ∧ kind a = Q↩⇘get_proc n⇙f"
proof(induct arbitrary:n' rule:vpra_induct)
case (vpra_empty cs)
from ‹valid_return_list cs n'› ‹cs ≠ []› obtain Q f where "valid_edge (hd cs)"
and "kind (hd cs) = Q↩⇘get_proc n'⇙f"
apply(unfold valid_return_list_def)
apply(drule hd_Cons_tl[THEN sym])
apply(erule_tac x="[]" in allE)
apply(erule_tac x="hd cs" in allE)
by auto
from ‹n -[]→* n'› have "n = n'" by fastforce
with ‹valid_edge (hd cs)› ‹kind (hd cs) = Q↩⇘get_proc n'⇙f› show ?case by blast
next
case (vpra_intra cs a as)
note IH = ‹⋀n'. ⟦n -as→* n'; valid_return_list cs n'; cs ≠ [];
∀xs ys. as = xs@ys ⟶ ¬ same_level_path_rev_aux cs ys ∨ upd_rev_cs cs ys ≠ []⟧
⟹ ∃a Q f. valid_edge a ∧ kind a = Q↩⇘get_proc n⇙f›
note all = ‹∀xs ys. as@[a] = xs@ys
⟶ ¬ same_level_path_rev_aux cs ys ∨ upd_rev_cs cs ys ≠ []›
from ‹n -as@[a]→* n'› have "n -as→* sourcenode a" and "valid_edge a"
and "targetnode a = n'" by(auto intro:path_split_snoc)
from ‹valid_return_list cs n'› ‹cs ≠ []› obtain Q f where "valid_edge (hd cs)"
and "kind (hd cs) = Q↩⇘get_proc n'⇙f"
apply(unfold valid_return_list_def)
apply(drule hd_Cons_tl[THEN sym])
apply(erule_tac x="[]" in allE)
apply(erule_tac x="hd cs" in allE)
by auto
from ‹valid_edge a› ‹intra_kind (kind a)›
have "get_proc (sourcenode a) = get_proc (targetnode a)" by(rule get_proc_intra)
with ‹kind (hd cs) = Q↩⇘get_proc n'⇙f› ‹targetnode a = n'›
have "kind (hd cs) = Q↩⇘get_proc (sourcenode a)⇙f" by simp
from ‹valid_return_list cs n'› ‹targetnode a = n'›
‹get_proc (sourcenode a) = get_proc (targetnode a)›
have "valid_return_list cs (sourcenode a)"
apply(clarsimp simp:valid_return_list_def)
apply(erule_tac x="cs'" in allE)
apply(erule_tac x="c" in allE)
by(auto split:list.split)
from all ‹intra_kind (kind a)›
have "∀xs ys. as = xs@ys
⟶ ¬ same_level_path_rev_aux cs ys ∨ upd_rev_cs cs ys ≠ []"
apply clarsimp apply(erule_tac x="xs" in allE)
by(auto simp:intra_kind_def)
from IH[OF ‹n -as→* sourcenode a› ‹valid_return_list cs (sourcenode a)›
‹cs ≠ []› this] show ?case .
next
case (vpra_Return cs a as Q p f)
note IH = ‹⋀n'. ⟦n -as→* n'; valid_return_list (a#cs) n'; a#cs ≠ [];
∀xs ys. as = xs @ ys ⟶
¬ same_level_path_rev_aux (a#cs) ys ∨ upd_rev_cs (a#cs) ys ≠ []⟧
⟹ ∃a Q f. valid_edge a ∧ kind a = Q↩⇘get_proc n⇙f›
from ‹n -as@[a]→* n'› have "n -as→* sourcenode a" and "valid_edge a"
and "targetnode a = n'" by(auto intro:path_split_snoc)
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f› have "get_proc (sourcenode a) = p"
by(rule get_proc_return)
with ‹kind a = Q↩⇘p⇙f› ‹valid_return_list cs n'› ‹valid_edge a› ‹targetnode a = n'›
have "valid_return_list (a#cs) (sourcenode a)"
apply(clarsimp simp:valid_return_list_def)
apply(case_tac cs') apply auto
apply(erule_tac x="list" in allE)
apply(erule_tac x="c" in allE)
by(auto split:list.split simp:targetnodes_def)
from ‹∀xs ys. as@[a] = xs@ys ⟶
¬ same_level_path_rev_aux cs ys ∨ upd_rev_cs cs ys ≠ []› ‹kind a = Q↩⇘p⇙f›
have "∀xs ys. as = xs@ys ⟶
¬ same_level_path_rev_aux (a#cs) ys ∨ upd_rev_cs (a#cs) ys ≠ []"
apply clarsimp apply(erule_tac x="xs" in allE)
by auto
from IH[OF ‹n -as→* sourcenode a› ‹valid_return_list (a#cs) (sourcenode a)›
_ this] show ?case by simp
next
case (vpra_CallEmpty cs a as Q p fs)
from ‹cs = []› ‹cs ≠ []› have False by simp
thus ?case by simp
next
case (vpra_CallCons cs a as Q r p fs c' cs')
note IH = ‹⋀n'. ⟦n -as→* n'; valid_return_list cs' n'; cs' ≠ [];
∀xs ys. as = xs@ys ⟶
¬ same_level_path_rev_aux cs' ys ∨ upd_rev_cs cs' ys ≠ []⟧
⟹ ∃a Q f. valid_edge a ∧ kind a = Q↩⇘get_proc n⇙f›
note all = ‹∀xs ys. as@[a] = xs@ys ⟶
¬ same_level_path_rev_aux cs ys ∨ upd_rev_cs cs ys ≠ []›
from ‹n -as@[a]→* n'› have "n -as→* sourcenode a" and "valid_edge a"
and "targetnode a = n'" by(auto intro:path_split_snoc)
from ‹valid_return_list cs n'› ‹cs = c'#cs'› have "valid_edge c'"
apply(clarsimp simp:valid_return_list_def)
apply(erule_tac x="[]" in allE)
by auto
show ?case
proof(cases "cs' = []")
case True
with ‹cs = c'#cs'› ‹kind a = Q:r↪⇘p⇙fs› ‹c' ∈ get_return_edges a›
have "same_level_path_rev_aux cs ([]@[a])"
and "upd_rev_cs cs ([]@[a]) = []"
by(simp only:same_level_path_rev_aux.simps upd_rev_cs.simps,clarsimp)+
with all have False by(erule_tac x="as" in allE) fastforce
thus ?thesis by simp
next
case False
with ‹valid_return_list cs n'› ‹cs = c'#cs'›
have "valid_return_list cs' (targetnode c')"
apply(clarsimp simp:valid_return_list_def)
apply(hypsubst_thin)
apply(erule_tac x="c'#cs'" in allE)
apply(auto simp:targetnodes_def)
apply(case_tac cs') apply auto
apply(case_tac list) apply(auto simp:targetnodes_def)
done
from ‹valid_edge a› ‹c' ∈ get_return_edges a›
have "get_proc (sourcenode a) = get_proc (targetnode c')"
by(rule get_proc_get_return_edge)
with ‹valid_return_list cs' (targetnode c')›
have "valid_return_list cs' (sourcenode a)"
apply(clarsimp simp:valid_return_list_def)
apply(hypsubst_thin)
apply(erule_tac x="cs'" in allE)
apply(erule_tac x="c" in allE)
by(auto split:list.split)
from all ‹kind a = Q:r↪⇘p⇙fs› ‹cs = c'#cs'› ‹c' ∈ get_return_edges a›
have "∀xs ys. as = xs@ys
⟶ ¬ same_level_path_rev_aux cs' ys ∨ upd_rev_cs cs' ys ≠ []"
apply clarsimp apply(erule_tac x="xs" in allE)
by auto
from IH[OF ‹n -as→* sourcenode a› ‹valid_return_list cs' (sourcenode a)›
False this] show ?thesis .
qed
qed
lemma valid_Entry_path_cases:
assumes "(_Entry_) -as→⇩√* n" and "as ≠ []"
shows "(∃a' as'. as = as'@[a'] ∧ intra_kind(kind a')) ∨
(∃a' as' Q r p fs. as = as'@[a'] ∧ kind a' = Q:r↪⇘p⇙fs) ∨
(∃as' as'' n'. as = as'@as'' ∧ as'' ≠ [] ∧ n' -as''→⇘sl⇙* n)"
proof -
from ‹as ≠ []› obtain a' as' where "as = as'@[a']" by(cases as rule:rev_cases) auto
thus ?thesis
proof(cases "kind a'" rule:edge_kind_cases)
case Intra with ‹as = as'@[a']› show ?thesis by simp
next
case Call with ‹as = as'@[a']› show ?thesis by simp
next
case (Return Q p f)
from ‹(_Entry_) -as→⇩√* n› have "(_Entry_) -as→* n" and "valid_path_rev_aux [] as"
by(auto intro:vp_to_vpra simp:vp_def valid_path_def)
from ‹(_Entry_) -as→* n› ‹as = as'@[a']›
have "(_Entry_) -as'→* sourcenode a'" and "valid_edge a'"
and "targetnode a' = n"
by(auto intro:path_split_snoc)
from ‹valid_path_rev_aux [] as› ‹as = as'@[a']› Return
have "valid_path_rev_aux [a'] as'" by simp
from ‹valid_edge a'› Return
have "valid_return_list [a'] (sourcenode a')"
apply(clarsimp simp:valid_return_list_def)
apply(case_tac cs')
by(auto intro:get_proc_return[THEN sym])
show ?thesis
proof(cases "∀xs ys. as' = xs@ys ⟶
(¬ same_level_path_rev_aux [a'] ys ∨ upd_rev_cs [a'] ys ≠ [])")
case True
with ‹valid_path_rev_aux [a'] as'› ‹(_Entry_) -as'→* sourcenode a'›
‹valid_return_list [a'] (sourcenode a')›
obtain ax Qx fx where "valid_edge ax" and "kind ax = Qx↩⇘get_proc (_Entry_)⇙fx"
by(fastforce dest!:vpra_no_slpra)
hence False by(fastforce intro:Main_no_return_source simp:get_proc_Entry)
thus ?thesis by simp
next
case False
then obtain xs ys where "as' = xs@ys" and "same_level_path_rev_aux [a'] ys"
and "upd_rev_cs [a'] ys = []" by auto
with Return have "same_level_path_rev_aux [] (ys@[a'])"
and "upd_rev_cs [] (ys@[a']) = []" by simp_all
from ‹upd_rev_cs [a'] ys = []› have "ys ≠ []" by auto
with ‹(_Entry_) -as'→* sourcenode a'› ‹as' = xs@ys›
have "hd(sourcenodes ys) -ys→* sourcenode a'"
by(cases ys)(auto dest:path_split_second simp:sourcenodes_def)
with ‹targetnode a' = n› ‹valid_edge a'›
have "hd(sourcenodes ys) -ys@[a']→* n"
by(fastforce intro:path_Append path_edge)
with ‹same_level_path_rev_aux [] (ys@[a'])› ‹upd_rev_cs [] (ys@[a']) = []›
have "same_level_path (ys@[a'])"
by(fastforce dest:slpra_to_slpa simp:same_level_path_def valid_return_list_def)
with ‹hd(sourcenodes ys) -ys@[a']→* n› have "hd(sourcenodes ys) -ys@[a']→⇘sl⇙* n"
by(simp add:slp_def)
with ‹as = as'@[a']› ‹as' = xs@ys› Return
have "∃as' as'' n'. as = as'@as'' ∧ as'' ≠ [] ∧ n' -as''→⇘sl⇙* n"
by(rule_tac x="xs" in exI) auto
thus ?thesis by simp
qed
qed
qed
lemma valid_Entry_path_ascending_path:
assumes "(_Entry_) -as→⇩√* n"
obtains as' where "(_Entry_) -as'→⇩√* n"
and "set(sourcenodes as') ⊆ set(sourcenodes as)"
and "∀a' ∈ set as'. intra_kind(kind a') ∨ (∃Q r p fs. kind a' = Q:r↪⇘p⇙fs)"
proof(atomize_elim)
from ‹(_Entry_) -as→⇩√* n›
show "∃as'. (_Entry_) -as'→⇩√* n ∧ set(sourcenodes as') ⊆ set(sourcenodes as)∧
(∀a' ∈ set as'. intra_kind(kind a') ∨ (∃Q r p fs. kind a' = Q:r↪⇘p⇙fs))"
proof(induct as arbitrary:n rule:length_induct)
fix as n
assume IH:"∀as''. length as'' < length as ⟶
(∀n'. (_Entry_) -as''→⇩√* n' ⟶
(∃as'. (_Entry_) -as'→⇩√* n' ∧ set (sourcenodes as') ⊆ set (sourcenodes as'') ∧
(∀a'∈set as'. intra_kind (kind a') ∨ (∃Q r p fs. kind a' = Q:r↪⇘p⇙fs))))"
and "(_Entry_) -as→⇩√* n"
show "∃as'. (_Entry_) -as'→⇩√* n ∧ set(sourcenodes as') ⊆ set(sourcenodes as)∧
(∀a' ∈ set as'. intra_kind(kind a') ∨ (∃Q r p fs. kind a' = Q:r↪⇘p⇙fs))"
proof(cases "as = []")
case True
with ‹(_Entry_) -as→⇩√* n› show ?thesis by(fastforce simp:sourcenodes_def vp_def)
next
case False
with ‹(_Entry_) -as→⇩√* n›
have "((∃a' as'. as = as'@[a'] ∧ intra_kind(kind a')) ∨
(∃a' as' Q r p fs. as = as'@[a'] ∧ kind a' = Q:r↪⇘p⇙fs)) ∨
(∃as' as'' n'. as = as'@as'' ∧ as'' ≠ [] ∧ n' -as''→⇘sl⇙* n)"
by(fastforce dest!:valid_Entry_path_cases)
thus ?thesis apply -
proof(erule disjE)+
assume "∃a' as'. as = as'@[a'] ∧ intra_kind(kind a')"
then obtain a' as' where "as = as'@[a']" and "intra_kind(kind a')" by blast
from ‹(_Entry_) -as→⇩√* n› ‹as = as'@[a']›
have "(_Entry_) -as'→⇩√* sourcenode a'" and "valid_edge a'"
and "targetnode a' = n"
by(auto intro:vp_split_snoc)
from ‹valid_edge a'› ‹intra_kind(kind a')›
have "sourcenode a' -[a']→⇘sl⇙* targetnode a'"
by(fastforce intro:path_edge intras_same_level_path simp:slp_def)
from IH ‹(_Entry_) -as'→⇩√* sourcenode a'› ‹as = as'@[a']›
obtain xs where "(_Entry_) -xs→⇩√* sourcenode a'"
and "set (sourcenodes xs) ⊆ set (sourcenodes as')"
and "∀a'∈set xs. intra_kind (kind a') ∨ (∃Q r p fs. kind a' = Q:r↪⇘p⇙fs)"
apply(erule_tac x="as'" in allE) by auto
from ‹(_Entry_) -xs→⇩√* sourcenode a'› ‹sourcenode a' -[a']→⇘sl⇙* targetnode a'›
have "(_Entry_) -xs@[a']→⇩√* targetnode a'" by(rule vp_slp_Append)
with ‹targetnode a' = n› have "(_Entry_) -xs@[a']→⇩√* n" by simp
moreover
from ‹set (sourcenodes xs) ⊆ set (sourcenodes as')› ‹as = as'@[a']›
have "set (sourcenodes (xs@[a'])) ⊆ set (sourcenodes as)"
by(auto simp:sourcenodes_def)
moreover
from ‹∀a'∈set xs. intra_kind (kind a') ∨ (∃Q r p fs. kind a' = Q:r↪⇘p⇙fs)›
‹intra_kind(kind a')›
have "∀a'∈set (xs@[a']). intra_kind (kind a') ∨
(∃Q r p fs. kind a' = Q:r↪⇘p⇙fs)"
by fastforce
ultimately show ?thesis by blast
next
assume "∃a' as' Q r p fs. as = as'@[a'] ∧ kind a' = Q:r↪⇘p⇙fs"
then obtain a' as' Q r p fs where "as = as'@[a']" and "kind a' = Q:r↪⇘p⇙fs"
by blast
from ‹(_Entry_) -as→⇩√* n› ‹as = as'@[a']›
have "(_Entry_) -as'→⇩√* sourcenode a'" and "valid_edge a'"
and "targetnode a' = n"
by(auto intro:vp_split_snoc)
from IH ‹(_Entry_) -as'→⇩√* sourcenode a'› ‹as = as'@[a']›
obtain xs where "(_Entry_) -xs→⇩√* sourcenode a'"
and "set (sourcenodes xs) ⊆ set (sourcenodes as')"
and "∀a'∈set xs. intra_kind (kind a') ∨ (∃Q r p fs. kind a' = Q:r↪⇘p⇙fs)"
apply(erule_tac x="as'" in allE) by auto
from ‹targetnode a' = n› ‹valid_edge a'› ‹kind a' = Q:r↪⇘p⇙fs›
‹(_Entry_) -xs→⇩√* sourcenode a'›
have "(_Entry_) -xs@[a']→⇩√* n"
by(fastforce intro:path_Append path_edge vpa_snoc_Call
simp:vp_def valid_path_def)
moreover
from ‹set (sourcenodes xs) ⊆ set (sourcenodes as')› ‹as = as'@[a']›
have "set (sourcenodes (xs@[a'])) ⊆ set (sourcenodes as)"
by(auto simp:sourcenodes_def)
moreover
from ‹∀a'∈set xs. intra_kind (kind a') ∨ (∃Q r p fs. kind a' = Q:r↪⇘p⇙fs)›
‹kind a' = Q:r↪⇘p⇙fs›
have "∀a'∈set (xs@[a']). intra_kind (kind a') ∨
(∃Q r p fs. kind a' = Q:r↪⇘p⇙fs)"
by fastforce
ultimately show ?thesis by blast
next
assume "∃as' as'' n'. as = as'@as'' ∧ as'' ≠ [] ∧ n' -as''→⇘sl⇙* n"
then obtain as' as'' n' where "as = as'@as''" and "as'' ≠ []"
and "n' -as''→⇘sl⇙* n" by blast
from ‹(_Entry_) -as→⇩√* n› ‹as = as'@as''› ‹as'' ≠ []›
have "(_Entry_) -as'→⇩√* hd(sourcenodes as'')"
by(cases as'',auto intro:vp_split simp:sourcenodes_def)
from ‹n' -as''→⇘sl⇙* n› ‹as'' ≠ []› have "hd(sourcenodes as'') = n'"
by(fastforce intro:path_sourcenode simp:slp_def)
from ‹as = as'@as''› ‹as'' ≠ []› have "length as' < length as" by simp
with IH ‹(_Entry_) -as'→⇩√* hd(sourcenodes as'')›
‹hd(sourcenodes as'') = n'›
obtain xs where "(_Entry_) -xs→⇩√* n'"
and "set (sourcenodes xs) ⊆ set (sourcenodes as')"
and "∀a'∈set xs. intra_kind (kind a') ∨ (∃Q r p fs. kind a' = Q:r↪⇘p⇙fs)"
apply(erule_tac x="as'" in allE) by auto
from ‹n' -as''→⇘sl⇙* n› obtain ys where "n' -ys→⇩ι* n"
and "set(sourcenodes ys) ⊆ set(sourcenodes as'')"
by(erule same_level_path_inner_path)
from ‹(_Entry_) -xs→⇩√* n'› ‹n' -ys→⇩ι* n› have "(_Entry_) -xs@ys→⇩√* n"
by(fastforce intro:vp_slp_Append intra_path_slp)
moreover
from ‹set (sourcenodes xs) ⊆ set (sourcenodes as')›
‹set(sourcenodes ys) ⊆ set(sourcenodes as'')› ‹as = as'@as''›
have "set (sourcenodes (xs@ys)) ⊆ set(sourcenodes as)"
by(auto simp:sourcenodes_def)
moreover
from ‹∀a'∈set xs. intra_kind (kind a') ∨ (∃Q r p fs. kind a' = Q:r↪⇘p⇙fs)›
‹n' -ys→⇩ι* n›
have "∀a'∈set (xs@ys). intra_kind (kind a') ∨ (∃Q r p fs. kind a' = Q:r↪⇘p⇙fs)"
by(fastforce simp:intra_path_def)
ultimately show ?thesis by blast
qed
qed
qed
qed
end
end
Theory CFGExit
theory CFGExit imports CFG begin
subsection ‹Adds an exit node to the abstract CFG›
locale CFGExit = CFG sourcenode targetnode kind valid_edge Entry
get_proc get_return_edges procs Main
for sourcenode :: "'edge ⇒ 'node" and targetnode :: "'edge ⇒ 'node"
and kind :: "'edge ⇒ ('var,'val,'ret,'pname) edge_kind"
and valid_edge :: "'edge ⇒ bool"
and Entry :: "'node" ("'('_Entry'_')") and get_proc :: "'node ⇒ 'pname"
and get_return_edges :: "'edge ⇒ 'edge set"
and procs :: "('pname × 'var list × 'var list) list" and Main :: "'pname" +
fixes Exit::"'node" ("'('_Exit'_')")
assumes Exit_source [dest]: "⟦valid_edge a; sourcenode a = (_Exit_)⟧ ⟹ False"
and get_proc_Exit:"get_proc (_Exit_) = Main"
and Exit_no_return_target:
"⟦valid_edge a; kind a = Q↩⇘p⇙f; targetnode a = (_Exit_)⟧ ⟹ False"
and Entry_Exit_edge: "∃a. valid_edge a ∧ sourcenode a = (_Entry_) ∧
targetnode a = (_Exit_) ∧ kind a = (λs. False)⇩√"
begin
lemma Entry_noteq_Exit [dest]:
assumes eq:"(_Entry_) = (_Exit_)" shows "False"
proof -
from Entry_Exit_edge obtain a where "sourcenode a = (_Entry_)"
and "valid_edge a" by blast
with eq show False by simp(erule Exit_source)
qed
lemma Exit_noteq_Entry [dest]:"(_Exit_) = (_Entry_) ⟹ False"
by(rule Entry_noteq_Exit[OF sym],simp)
lemma [simp]: "valid_node (_Entry_)"
proof -
from Entry_Exit_edge obtain a where "sourcenode a = (_Entry_)"
and "valid_edge a" by blast
thus ?thesis by(fastforce simp:valid_node_def)
qed
lemma [simp]: "valid_node (_Exit_)"
proof -
from Entry_Exit_edge obtain a where "targetnode a = (_Exit_)"
and "valid_edge a" by blast
thus ?thesis by(fastforce simp:valid_node_def)
qed
subsubsection ‹Definition of ‹method_exit››
definition method_exit :: "'node ⇒ bool"
where "method_exit n ≡ n = (_Exit_) ∨
(∃a Q p f. n = sourcenode a ∧ valid_edge a ∧ kind a = Q↩⇘p⇙f)"
lemma method_exit_cases:
"⟦method_exit n; n = (_Exit_) ⟹ P;
⋀a Q f p. ⟦n = sourcenode a; valid_edge a; kind a = Q↩⇘p⇙f⟧ ⟹ P⟧ ⟹ P"
by(fastforce simp:method_exit_def)
lemma method_exit_inner_path:
assumes "method_exit n" and "n -as→⇩ι* n'" shows "as = []"
using ‹method_exit n›
proof(rule method_exit_cases)
assume "n = (_Exit_)"
show ?thesis
proof(cases as)
case (Cons a' as')
with ‹n -as→⇩ι* n'› have "n = sourcenode a'" and "valid_edge a'"
by(auto elim:path_split_Cons simp:intra_path_def)
with ‹n = (_Exit_)› have "sourcenode a' = (_Exit_)" by simp
with ‹valid_edge a'› have False by(rule Exit_source)
thus ?thesis by simp
qed simp
next
fix a Q f p
assume "n = sourcenode a" and "valid_edge a" and "kind a = Q↩⇘p⇙f"
show ?thesis
proof(cases as)
case (Cons a' as')
with ‹n -as→⇩ι* n'› have "n = sourcenode a'" and "valid_edge a'"
and "intra_kind (kind a')"
by(auto elim:path_split_Cons simp:intra_path_def)
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f› ‹valid_edge a'› ‹n = sourcenode a›
‹n = sourcenode a'› ‹intra_kind (kind a')›
have False by(fastforce dest:return_edges_only simp:intra_kind_def)
thus ?thesis by simp
qed simp
qed
subsubsection ‹Definition of ‹inner_node››
definition inner_node :: "'node ⇒ bool"
where inner_node_def:
"inner_node n ≡ valid_node n ∧ n ≠ (_Entry_) ∧ n ≠ (_Exit_)"
lemma inner_is_valid:
"inner_node n ⟹ valid_node n"
by(simp add:inner_node_def valid_node_def)
lemma [dest]:
"inner_node (_Entry_) ⟹ False"
by(simp add:inner_node_def)
lemma [dest]:
"inner_node (_Exit_) ⟹ False"
by(simp add:inner_node_def)
lemma [simp]:"⟦valid_edge a; targetnode a ≠ (_Exit_)⟧
⟹ inner_node (targetnode a)"
by(simp add:inner_node_def,rule ccontr,simp,erule Entry_target)
lemma [simp]:"⟦valid_edge a; sourcenode a ≠ (_Entry_)⟧
⟹ inner_node (sourcenode a)"
by(simp add:inner_node_def,rule ccontr,simp,erule Exit_source)
lemma valid_node_cases [consumes 1, case_names "Entry" "Exit" "inner"]:
"⟦valid_node n; n = (_Entry_) ⟹ Q; n = (_Exit_) ⟹ Q;
inner_node n ⟹ Q⟧ ⟹ Q"
apply(auto simp:valid_node_def)
apply(case_tac "sourcenode a = (_Entry_)") apply auto
apply(case_tac "targetnode a = (_Exit_)") apply auto
done
subsubsection ‹Lemmas on paths with ‹(_Exit_)››
lemma path_Exit_source:
"⟦n -as→* n'; n = (_Exit_)⟧ ⟹ n' = (_Exit_) ∧ as = []"
proof(induct rule:path.induct)
case (Cons_path n'' as n' a n)
from ‹n = (_Exit_)› ‹sourcenode a = n› ‹valid_edge a› have False
by -(rule Exit_source,simp_all)
thus ?case by simp
qed simp
lemma [dest]:"(_Exit_) -as→* n' ⟹ n' = (_Exit_) ∧ as = []"
by(fastforce elim!:path_Exit_source)
lemma Exit_no_sourcenode[dest]:
assumes isin:"(_Exit_) ∈ set (sourcenodes as)" and path:"n -as→* n'"
shows False
proof -
from isin obtain ns' ns'' where "sourcenodes as = ns'@(_Exit_)#ns''"
by(auto dest:split_list simp:sourcenodes_def)
then obtain as' as'' a where "as = as'@a#as''"
and source:"sourcenode a = (_Exit_)"
by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
with path have "valid_edge a" by(fastforce dest:path_split)
with source show ?thesis by -(erule Exit_source)
qed
lemma vpa_no_slpa:
"⟦valid_path_aux cs as; n -as→* n'; valid_call_list cs n; cs ≠ [];
∀xs ys. as = xs@ys ⟶ (¬ same_level_path_aux cs xs ∨ upd_cs cs xs ≠ [])⟧
⟹ ∃a Q r fs. valid_edge a ∧ kind a = Q:r↪⇘get_proc n'⇙fs"
proof(induct arbitrary:n rule:vpa_induct)
case (vpa_empty cs)
from ‹valid_call_list cs n› ‹cs ≠ []› obtain Q r fs where "valid_edge (hd cs)"
and "kind (hd cs) = Q:r↪⇘get_proc n⇙fs"
apply(unfold valid_call_list_def)
apply(drule hd_Cons_tl[THEN sym])
apply(erule_tac x="[]" in allE)
apply(erule_tac x="hd cs" in allE)
by auto
from ‹n -[]→* n'› have "n = n'" by fastforce
with ‹valid_edge (hd cs)› ‹kind (hd cs) = Q:r↪⇘get_proc n⇙fs› show ?case by blast
next
case (vpa_intra cs a as)
note IH = ‹⋀n. ⟦n -as→* n'; valid_call_list cs n; cs ≠ [];
∀xs ys. as = xs@ys ⟶ ¬ same_level_path_aux cs xs ∨ upd_cs cs xs ≠ []⟧
⟹ ∃a' Q' r' fs'. valid_edge a' ∧ kind a' = Q':r'↪⇘get_proc n'⇙fs'›
note all = ‹∀xs ys. a#as = xs@ys
⟶ ¬ same_level_path_aux cs xs ∨ upd_cs cs xs ≠ []›
from ‹n -a#as→* n'› have "sourcenode a = n" and "valid_edge a"
and "targetnode a -as→* n'"
by(auto intro:path_split_Cons)
from ‹valid_call_list cs n› ‹cs ≠ []› obtain Q r fs where "valid_edge (hd cs)"
and "kind (hd cs) = Q:r↪⇘get_proc n⇙fs"
apply(unfold valid_call_list_def)
apply(drule hd_Cons_tl[THEN sym])
apply(erule_tac x="[]" in allE)
apply(erule_tac x="hd cs" in allE)
by auto
from ‹valid_edge a› ‹intra_kind (kind a)›
have "get_proc (sourcenode a) = get_proc (targetnode a)" by(rule get_proc_intra)
with ‹kind (hd cs) = Q:r↪⇘get_proc n⇙fs› ‹sourcenode a = n›
have "kind (hd cs) = Q:r↪⇘get_proc (targetnode a)⇙fs" by simp
from ‹valid_call_list cs n› ‹sourcenode a = n›
‹get_proc (sourcenode a) = get_proc (targetnode a)›
have "valid_call_list cs (targetnode a)"
apply(clarsimp simp:valid_call_list_def)
apply(erule_tac x="cs'" in allE)
apply(erule_tac x="c" in allE)
by(auto split:list.split)
from all ‹intra_kind (kind a)›
have "∀xs ys. as = xs@ys ⟶ ¬ same_level_path_aux cs xs ∨ upd_cs cs xs ≠ []"
apply clarsimp apply(erule_tac x="a#xs" in allE)
by(auto simp:intra_kind_def)
from IH[OF ‹targetnode a -as→* n'› ‹valid_call_list cs (targetnode a)›
‹cs ≠ []› this] show ?case .
next
case (vpa_Call cs a as Q r p fs)
note IH = ‹⋀n. ⟦n -as→* n'; valid_call_list (a#cs) n; a#cs ≠ [];
∀xs ys. as = xs@ys ⟶ ¬ same_level_path_aux (a#cs) xs ∨ upd_cs (a#cs) xs ≠ []⟧
⟹ ∃a' Q' r' fs'. valid_edge a' ∧ kind a' = Q':r'↪⇘get_proc n'⇙fs'›
note all = ‹∀xs ys.
a#as = xs@ys ⟶ ¬ same_level_path_aux cs xs ∨ upd_cs cs xs ≠ []›
from ‹n -a#as→* n'› have "sourcenode a = n" and "valid_edge a"
and "targetnode a -as→* n'"
by(auto intro:path_split_Cons)
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› have "get_proc (targetnode a) = p"
by(rule get_proc_call)
with ‹kind a = Q:r↪⇘p⇙fs› have "kind a = Q:r↪⇘get_proc (targetnode a)⇙fs" by simp
with ‹valid_call_list cs n› ‹valid_edge a› ‹sourcenode a = n›
have "valid_call_list (a#cs) (targetnode a)"
apply(clarsimp simp:valid_call_list_def)
apply(case_tac cs') apply auto
apply(erule_tac x="list" in allE)
apply(erule_tac x="c" in allE)
by(auto split:list.split simp:sourcenodes_def)
from all ‹kind a = Q:r↪⇘p⇙fs›
have "∀xs ys. as = xs@ys
⟶ ¬ same_level_path_aux (a#cs) xs ∨ upd_cs (a#cs) xs ≠ []"
apply clarsimp apply(erule_tac x="a#xs" in allE)
by auto
from IH[OF ‹targetnode a -as→* n'› ‹valid_call_list (a#cs) (targetnode a)›
_ this] show ?case by simp
next
case (vpa_ReturnEmpty cs a as Q p fx)
from ‹cs ≠ []› ‹cs = []› have False by simp
thus ?case by simp
next
case (vpa_ReturnCons cs a as Q p f c' cs')
note IH = ‹⋀n. ⟦n -as→* n'; valid_call_list cs' n; cs' ≠ [];
∀xs ys. as = xs@ys ⟶ ¬ same_level_path_aux cs' xs ∨ upd_cs cs' xs ≠ []⟧
⟹ ∃a' Q' r' fs'. valid_edge a' ∧ kind a' = Q':r'↪⇘get_proc n'⇙fs'›
note all = ‹∀xs ys. a#as = xs@ys
⟶ ¬ same_level_path_aux cs xs ∨ upd_cs cs xs ≠ []›
from ‹n -a#as→* n'› have "sourcenode a = n" and "valid_edge a"
and "targetnode a -as→* n'"
by(auto intro:path_split_Cons)
from ‹valid_call_list cs n› ‹cs = c'#cs'› have "valid_edge c'"
apply(clarsimp simp:valid_call_list_def)
apply(erule_tac x="[]" in allE)
by auto
show ?case
proof(cases "cs' = []")
case True
with all ‹cs = c'#cs'› ‹kind a = Q↩⇘p⇙f› ‹a ∈ get_return_edges c'› have False
by(erule_tac x="[a]" in allE,fastforce)
thus ?thesis by simp
next
case False
with ‹valid_call_list cs n› ‹cs = c'#cs'›
have "valid_call_list cs' (sourcenode c')"
apply(clarsimp simp:valid_call_list_def)
apply(hypsubst_thin)
apply(erule_tac x="c'#cs'" in allE)
apply(auto simp:sourcenodes_def)
apply(case_tac cs') apply auto
apply(case_tac list) apply(auto simp:sourcenodes_def)
done
from ‹valid_edge c'› ‹a ∈ get_return_edges c'›
have "get_proc (sourcenode c') = get_proc (targetnode a)"
by(rule get_proc_get_return_edge)
with ‹valid_call_list cs' (sourcenode c')›
have "valid_call_list cs' (targetnode a)"
apply(clarsimp simp:valid_call_list_def)
apply(hypsubst_thin)
apply(erule_tac x="cs'" in allE)
apply(erule_tac x="c" in allE)
by(auto split:list.split)
from all ‹kind a = Q↩⇘p⇙f› ‹cs = c'#cs'› ‹a ∈ get_return_edges c'›
have "∀xs ys. as = xs@ys ⟶ ¬ same_level_path_aux cs' xs ∨ upd_cs cs' xs ≠ []"
apply clarsimp apply(erule_tac x="a#xs" in allE)
by auto
from IH[OF ‹targetnode a -as→* n'› ‹valid_call_list cs' (targetnode a)›
False this] show ?thesis .
qed
qed
lemma valid_Exit_path_cases:
assumes "n -as→⇩√* (_Exit_)" and "as ≠ []"
shows "(∃a' as'. as = a'#as' ∧ intra_kind(kind a')) ∨
(∃a' as' Q p f. as = a'#as' ∧ kind a' = Q↩⇘p⇙f) ∨
(∃as' as'' n'. as = as'@as'' ∧ as' ≠ [] ∧ n -as'→⇘sl⇙* n')"
proof -
from ‹as ≠ []› obtain a' as' where "as = a'#as'" by(cases as) auto
thus ?thesis
proof(cases "kind a'" rule:edge_kind_cases)
case Intra with ‹as = a'#as'› show ?thesis by simp
next
case Return with ‹as = a'#as'› show ?thesis by simp
next
case (Call Q r p f)
from ‹n -as→⇩√* (_Exit_)› have "n -as→* (_Exit_)" and "valid_path_aux [] as"
by(simp_all add:vp_def valid_path_def)
from ‹n -as→* (_Exit_)› ‹as = a'#as'›
have "sourcenode a' = n" and "valid_edge a'" and "targetnode a' -as'→* (_Exit_)"
by(auto intro:path_split_Cons)
from ‹valid_path_aux [] as› ‹as = a'#as'› Call
have "valid_path_aux [a'] as'" by simp
from ‹valid_edge a'› Call
have "valid_call_list [a'] (targetnode a')"
apply(clarsimp simp:valid_call_list_def)
apply(case_tac cs')
by(auto intro:get_proc_call[THEN sym])
show ?thesis
proof(cases "∀xs ys. as' = xs@ys ⟶
(¬ same_level_path_aux [a'] xs ∨ upd_cs [a'] xs ≠ [])")
case True
with ‹valid_path_aux [a'] as'› ‹targetnode a' -as'→* (_Exit_)›
‹valid_call_list [a'] (targetnode a')›
obtain ax Qx rx fsx where "valid_edge ax" and "kind ax = Qx:rx↪⇘get_proc (_Exit_)⇙fsx"
by(fastforce dest!:vpa_no_slpa)
hence False by(fastforce intro:Main_no_call_target simp:get_proc_Exit)
thus ?thesis by simp
next
case False
then obtain xs ys where "as' = xs@ys" and "same_level_path_aux [a'] xs"
and "upd_cs [a'] xs = []" by auto
with Call have "same_level_path (a'#xs)" by(simp add:same_level_path_def)
from ‹upd_cs [a'] xs = []› have "xs ≠ []" by auto
with ‹targetnode a' -as'→* (_Exit_)› ‹as' = xs@ys›
have "targetnode a' -xs→* last(targetnodes xs)"
apply(cases xs rule:rev_cases)
by(auto intro:path_Append path_split path_edge simp:targetnodes_def)
with ‹sourcenode a' = n› ‹valid_edge a'› ‹same_level_path (a'#xs)›
have "n -a'#xs→⇘sl⇙* last(targetnodes xs)"
by(fastforce intro:Cons_path simp:slp_def)
with ‹as = a'#as'› ‹as' = xs@ys› Call
have "∃as' as'' n'. as = as'@as'' ∧ as' ≠ [] ∧ n -as'→⇘sl⇙* n'"
by(rule_tac x="a'#xs" in exI) auto
thus ?thesis by simp
qed
qed
qed
lemma valid_Exit_path_descending_path:
assumes "n -as→⇩√* (_Exit_)"
obtains as' where "n -as'→⇩√* (_Exit_)"
and "set(sourcenodes as') ⊆ set(sourcenodes as)"
and "∀a' ∈ set as'. intra_kind(kind a') ∨ (∃Q f p. kind a' = Q↩⇘p⇙f)"
proof(atomize_elim)
from ‹n -as→⇩√* (_Exit_)›
show "∃as'. n -as'→⇩√* (_Exit_) ∧ set(sourcenodes as') ⊆ set(sourcenodes as)∧
(∀a' ∈ set as'. intra_kind(kind a') ∨ (∃Q f p. kind a' = Q↩⇘p⇙f))"
proof(induct as arbitrary:n rule:length_induct)
fix as n
assume IH:"∀as''. length as'' < length as ⟶
(∀n'. n' -as''→⇩√* (_Exit_) ⟶
(∃as'. n' -as'→⇩√* (_Exit_) ∧ set (sourcenodes as') ⊆ set (sourcenodes as'') ∧
(∀a'∈set as'. intra_kind (kind a') ∨ (∃Q f p. kind a' = Q↩⇘p⇙f))))"
and "n -as→⇩√* (_Exit_)"
show "∃as'. n -as'→⇩√* (_Exit_) ∧ set(sourcenodes as') ⊆ set(sourcenodes as)∧
(∀a' ∈ set as'. intra_kind(kind a') ∨ (∃Q f p. kind a' = Q↩⇘p⇙f))"
proof(cases "as = []")
case True
with ‹n -as→⇩√* (_Exit_)› show ?thesis by(fastforce simp:sourcenodes_def vp_def)
next
case False
with ‹n -as→⇩√* (_Exit_)›
have "((∃a' as'. as = a'#as' ∧ intra_kind(kind a')) ∨
(∃a' as' Q p f. as = a'#as' ∧ kind a' = Q↩⇘p⇙f)) ∨
(∃as' as'' n'. as = as'@as'' ∧ as' ≠ [] ∧ n -as'→⇘sl⇙* n')"
by(auto dest!:valid_Exit_path_cases)
thus ?thesis apply -
proof(erule disjE)+
assume "∃a' as'. as = a'#as' ∧ intra_kind(kind a')"
then obtain a' as' where "as = a'#as'" and "intra_kind(kind a')" by blast
from ‹n -as→⇩√* (_Exit_)› ‹as = a'#as'›
have "sourcenode a' = n" and "valid_edge a'"
and "targetnode a' -as'→⇩√* (_Exit_)"
by(auto intro:vp_split_Cons)
from ‹valid_edge a'› ‹intra_kind(kind a')›
have "sourcenode a' -[a']→⇘sl⇙* targetnode a'"
by(fastforce intro:path_edge intras_same_level_path simp:slp_def)
from IH ‹targetnode a' -as'→⇩√* (_Exit_)› ‹as = a'#as'›
obtain xs where "targetnode a' -xs→⇩√* (_Exit_)"
and "set (sourcenodes xs) ⊆ set (sourcenodes as')"
and "∀a'∈set xs. intra_kind (kind a') ∨ (∃Q f p. kind a' = Q↩⇘p⇙f)"
apply(erule_tac x="as'" in allE) by auto
from ‹sourcenode a' -[a']→⇘sl⇙* targetnode a'› ‹targetnode a' -xs→⇩√* (_Exit_)›
have "sourcenode a' -[a']@xs→⇩√* (_Exit_)" by(rule slp_vp_Append)
with ‹sourcenode a' = n› have "n -a'#xs→⇩√* (_Exit_)" by simp
moreover
from ‹set (sourcenodes xs) ⊆ set (sourcenodes as')› ‹as = a'#as'›
have "set (sourcenodes (a'#xs)) ⊆ set (sourcenodes as)"
by(auto simp:sourcenodes_def)
moreover
from ‹∀a'∈set xs. intra_kind (kind a') ∨ (∃Q f p. kind a' = Q↩⇘p⇙f)›
‹intra_kind(kind a')›
have "∀a'∈set (a'#xs). intra_kind (kind a') ∨ (∃Q f p. kind a' = Q↩⇘p⇙f)"
by fastforce
ultimately show ?thesis by blast
next
assume "∃a' as' Q p f. as = a'#as' ∧ kind a' = Q↩⇘p⇙f"
then obtain a' as' Q p f where "as = a'#as'" and "kind a' = Q↩⇘p⇙f" by blast
from ‹n -as→⇩√* (_Exit_)› ‹as = a'#as'›
have "sourcenode a' = n" and "valid_edge a'"
and "targetnode a' -as'→⇩√* (_Exit_)"
by(auto intro:vp_split_Cons)
from IH ‹targetnode a' -as'→⇩√* (_Exit_)› ‹as = a'#as'›
obtain xs where "targetnode a' -xs→⇩√* (_Exit_)"
and "set (sourcenodes xs) ⊆ set (sourcenodes as')"
and "∀a'∈set xs. intra_kind (kind a') ∨ (∃Q f p. kind a' = Q↩⇘p⇙f)"
apply(erule_tac x="as'" in allE) by auto
from ‹sourcenode a' = n› ‹valid_edge a'› ‹kind a' = Q↩⇘p⇙f›
‹targetnode a' -xs→⇩√* (_Exit_)›
have "n -a'#xs→⇩√* (_Exit_)"
by(fastforce intro:Cons_path simp:vp_def valid_path_def)
moreover
from ‹set (sourcenodes xs) ⊆ set (sourcenodes as')› ‹as = a'#as'›
have "set (sourcenodes (a'#xs)) ⊆ set (sourcenodes as)"
by(auto simp:sourcenodes_def)
moreover
from ‹∀a'∈set xs. intra_kind (kind a') ∨ (∃Q f p. kind a' = Q↩⇘p⇙f)›
‹kind a' = Q↩⇘p⇙f›
have "∀a'∈set (a'#xs). intra_kind (kind a') ∨ (∃Q f p. kind a' = Q↩⇘p⇙f)"
by fastforce
ultimately show ?thesis by blast
next
assume "∃as' as'' n'. as = as'@as'' ∧ as' ≠ [] ∧ n -as'→⇘sl⇙* n'"
then obtain as' as'' n' where "as = as'@as''" and "as' ≠ []"
and "n -as'→⇘sl⇙* n'" by blast
from ‹n -as→⇩√* (_Exit_)› ‹as = as'@as''› ‹as' ≠ []›
have "last(targetnodes as') -as''→⇩√* (_Exit_)"
by(cases as' rule:rev_cases,auto intro:vp_split simp:targetnodes_def)
from ‹n -as'→⇘sl⇙* n'› ‹as' ≠ []› have "last(targetnodes as') = n'"
by(fastforce intro:path_targetnode simp:slp_def)
from ‹as = as'@as''› ‹as' ≠ []› have "length as'' < length as" by simp
with IH ‹last(targetnodes as') -as''→⇩√* (_Exit_)›
‹last(targetnodes as') = n'›
obtain xs where "n' -xs→⇩√* (_Exit_)"
and "set (sourcenodes xs) ⊆ set (sourcenodes as'')"
and "∀a'∈set xs. intra_kind (kind a') ∨ (∃Q f p. kind a' = Q↩⇘p⇙f)"
apply(erule_tac x="as''" in allE) by auto
from ‹n -as'→⇘sl⇙* n'› obtain ys where "n -ys→⇩ι* n'"
and "set(sourcenodes ys) ⊆ set(sourcenodes as')"
by(erule same_level_path_inner_path)
from ‹n -ys→⇩ι* n'› ‹n' -xs→⇩√* (_Exit_)› have "n -ys@xs→⇩√* (_Exit_)"
by(fastforce intro:slp_vp_Append intra_path_slp)
moreover
from ‹set (sourcenodes xs) ⊆ set (sourcenodes as'')›
‹set(sourcenodes ys) ⊆ set(sourcenodes as')› ‹as = as'@as''›
have "set (sourcenodes (ys@xs)) ⊆ set(sourcenodes as)"
by(auto simp:sourcenodes_def)
moreover
from ‹∀a'∈set xs. intra_kind (kind a') ∨ (∃Q f p. kind a' = Q↩⇘p⇙f)›
‹n -ys→⇩ι* n'›
have "∀a'∈set (ys@xs). intra_kind (kind a') ∨ (∃Q f p. kind a' = Q↩⇘p⇙f)"
by(fastforce simp:intra_path_def)
ultimately show ?thesis by blast
qed
qed
qed
qed
lemma valid_Exit_path_intra_path:
assumes "n -as→⇩√* (_Exit_)"
obtains as' pex where "n -as'→⇩ι* pex" and "method_exit pex"
and "set(sourcenodes as') ⊆ set(sourcenodes as)"
proof(atomize_elim)
from ‹n -as→⇩√* (_Exit_)›
obtain as' where "n -as'→⇩√* (_Exit_)"
and "set(sourcenodes as') ⊆ set(sourcenodes as)"
and all:"∀a' ∈ set as'. intra_kind(kind a') ∨ (∃Q f p. kind a' = Q↩⇘p⇙f)"
by(erule valid_Exit_path_descending_path)
show "∃as' pex. n -as'→⇩ι* pex ∧ method_exit pex ∧
set(sourcenodes as') ⊆ set(sourcenodes as)"
proof(cases "∃a' ∈ set as'. ∃Q f p. kind a' = Q↩⇘p⇙f")
case True
then obtain asx ax asx' where [simp]:"as' = asx@ax#asx'"
and "∃Q f p. kind ax = Q↩⇘p⇙f" and "∀a' ∈ set asx. ¬ (∃Q f p. kind a' = Q↩⇘p⇙f)"
by(erule split_list_first_propE)
with all have "∀a' ∈ set asx. intra_kind(kind a')" by auto
from ‹n -as'→⇩√* (_Exit_)› have "n -asx→* sourcenode ax"
and "valid_edge ax" by(auto elim:path_split simp:vp_def)
from ‹n -asx→* sourcenode ax› ‹∀a' ∈ set asx. intra_kind(kind a')›
have "n -asx→⇩ι* sourcenode ax" by(simp add:intra_path_def)
moreover
from ‹valid_edge ax› ‹∃Q f p. kind ax = Q↩⇘p⇙f›
have "method_exit (sourcenode ax)" by(fastforce simp:method_exit_def)
moreover
from ‹set(sourcenodes as') ⊆ set(sourcenodes as)›
have "set(sourcenodes asx) ⊆ set(sourcenodes as)" by(simp add:sourcenodes_def)
ultimately show ?thesis by blast
next
case False
with all ‹n -as'→⇩√* (_Exit_)› have "n -as'→⇩ι* (_Exit_)"
by(fastforce simp:vp_def intra_path_def)
moreover have "method_exit (_Exit_)" by(simp add:method_exit_def)
ultimately show ?thesis using ‹set(sourcenodes as') ⊆ set(sourcenodes as)›
by blast
qed
qed
end
end
Theory CFG_wf
section ‹CFG well-formedness›
theory CFG_wf imports CFG begin
locale CFG_wf = CFG sourcenode targetnode kind valid_edge Entry
get_proc get_return_edges procs Main
for sourcenode :: "'edge ⇒ 'node" and targetnode :: "'edge ⇒ 'node"
and kind :: "'edge ⇒ ('var,'val,'ret,'pname) edge_kind"
and valid_edge :: "'edge ⇒ bool"
and Entry :: "'node" ("'('_Entry'_')") and get_proc :: "'node ⇒ 'pname"
and get_return_edges :: "'edge ⇒ 'edge set"
and procs :: "('pname × 'var list × 'var list) list" and Main :: "'pname" +
fixes Def::"'node ⇒ 'var set"
fixes Use::"'node ⇒ 'var set"
fixes ParamDefs::"'node ⇒ 'var list"
fixes ParamUses::"'node ⇒ 'var set list"
assumes Entry_empty:"Def (_Entry_) = {} ∧ Use (_Entry_) = {}"
and ParamUses_call_source_length:
"⟦valid_edge a; kind a = Q:r↪⇘p⇙fs; (p,ins,outs) ∈ set procs⟧
⟹ length(ParamUses (sourcenode a)) = length ins"
and distinct_ParamDefs:"valid_edge a ⟹ distinct (ParamDefs (targetnode a))"
and ParamDefs_return_target_length:
"⟦valid_edge a; kind a = Q'↩⇘p⇙f'; (p,ins,outs) ∈ set procs⟧
⟹ length(ParamDefs (targetnode a)) = length outs"
and ParamDefs_in_Def:
"⟦valid_node n; V ∈ set (ParamDefs n)⟧ ⟹ V ∈ Def n"
and ins_in_Def:
"⟦valid_edge a; kind a = Q:r↪⇘p⇙fs; (p,ins,outs) ∈ set procs; V ∈ set ins⟧
⟹ V ∈ Def (targetnode a)"
and call_source_Def_empty:
"⟦valid_edge a; kind a = Q:r↪⇘p⇙fs⟧ ⟹ Def (sourcenode a) = {}"
and ParamUses_in_Use:
"⟦valid_node n; V ∈ Union (set (ParamUses n))⟧ ⟹ V ∈ Use n"
and outs_in_Use:
"⟦valid_edge a; kind a = Q↩⇘p⇙f; (p,ins,outs) ∈ set procs; V ∈ set outs⟧
⟹ V ∈ Use (sourcenode a)"
and CFG_intra_edge_no_Def_equal:
"⟦valid_edge a; V ∉ Def (sourcenode a); intra_kind (kind a); pred (kind a) s⟧
⟹ state_val (transfer (kind a) s) V = state_val s V"
and CFG_intra_edge_transfer_uses_only_Use:
"⟦valid_edge a; ∀V ∈ Use (sourcenode a). state_val s V = state_val s' V;
intra_kind (kind a); pred (kind a) s; pred (kind a) s'⟧
⟹ ∀V ∈ Def (sourcenode a). state_val (transfer (kind a) s) V =
state_val (transfer (kind a) s') V"
and CFG_edge_Uses_pred_equal:
"⟦valid_edge a; pred (kind a) s; snd (hd s) = snd (hd s');
∀V ∈ Use (sourcenode a). state_val s V = state_val s' V; length s = length s'⟧
⟹ pred (kind a) s'"
and CFG_call_edge_length:
"⟦valid_edge a; kind a = Q:r↪⇘p⇙fs; (p,ins,outs) ∈ set procs⟧
⟹ length fs = length ins"
and CFG_call_determ:
"⟦valid_edge a; kind a = Q:r↪⇘p⇙fs; valid_edge a'; kind a' = Q':r'↪⇘p'⇙fs';
sourcenode a = sourcenode a'; pred (kind a) s; pred (kind a') s⟧
⟹ a = a'"
and CFG_call_edge_params:
"⟦valid_edge a; kind a = Q:r↪⇘p⇙fs; i < length ins;
(p,ins,outs) ∈ set procs; pred (kind a) s; pred (kind a) s';
∀V ∈ (ParamUses (sourcenode a))!i. state_val s V = state_val s' V⟧
⟹ (params fs (fst (hd s)))!i = (params fs (fst (hd s')))!i"
and CFG_return_edge_fun:
"⟦valid_edge a; kind a = Q'↩⇘p⇙f'; (p,ins,outs) ∈ set procs⟧
⟹ f' vmap vmap' = vmap'(ParamDefs (targetnode a) [:=] map vmap outs)"
and deterministic:"⟦valid_edge a; valid_edge a'; sourcenode a = sourcenode a';
targetnode a ≠ targetnode a'; intra_kind (kind a); intra_kind (kind a')⟧
⟹ ∃Q Q'. kind a = (Q)⇩√ ∧ kind a' = (Q')⇩√ ∧
(∀s. (Q s ⟶ ¬ Q' s) ∧ (Q' s ⟶ ¬ Q s))"
begin
lemma CFG_equal_Use_equal_call:
assumes "valid_edge a" and "kind a = Q:r↪⇘p⇙fs" and "valid_edge a'"
and "kind a' = Q':r'↪⇘p'⇙fs'" and "sourcenode a = sourcenode a'"
and "pred (kind a) s" and "pred (kind a') s'"
and "snd (hd s) = snd (hd s')" and "length s = length s'"
and "∀V ∈ Use (sourcenode a). state_val s V = state_val s' V"
shows "a = a'"
proof -
from ‹valid_edge a› ‹pred (kind a) s› ‹snd (hd s) = snd (hd s')›
‹∀V ∈ Use (sourcenode a). state_val s V = state_val s' V› ‹length s = length s'›
have "pred (kind a) s'" by(rule CFG_edge_Uses_pred_equal)
with ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹valid_edge a'› ‹kind a' = Q':r'↪⇘p'⇙fs'›
‹sourcenode a = sourcenode a'› ‹pred (kind a') s'›
show ?thesis by -(rule CFG_call_determ)
qed
lemma CFG_call_edge_param_in:
assumes "valid_edge a" and "kind a = Q:r↪⇘p⇙fs" and "i < length ins"
and "(p,ins,outs) ∈ set procs" and "pred (kind a) s" and "pred (kind a) s'"
and "∀V ∈ (ParamUses (sourcenode a))!i. state_val s V = state_val s' V"
shows "state_val (transfer (kind a) s) (ins!i) =
state_val (transfer (kind a) s') (ins!i)"
proof -
from assms have params:"(params fs (fst (hd s)))!i = (params fs (fst (hd s')))!i"
by(rule CFG_call_edge_params)
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹(p,ins,outs) ∈ set procs›
have [simp]:"(THE ins. ∃outs. (p,ins,outs) ∈ set procs) = ins"
by(rule formal_in_THE)
from ‹pred (kind a) s› obtain cf cfs where [simp]:"s = cf#cfs" by(cases s) auto
from ‹pred (kind a) s'› obtain cf' cfs' where [simp]:"s' = cf'#cfs'"
by(cases s') auto
from ‹kind a = Q:r↪⇘p⇙fs›
have eqs:"fst (hd (transfer (kind a) s)) = (Map.empty(ins [:=] params fs (fst cf)))"
"fst (hd (transfer (kind a) s')) = (Map.empty(ins [:=] params fs (fst cf')))"
by simp_all
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹(p,ins,outs) ∈ set procs›
have "length fs = length ins" by(rule CFG_call_edge_length)
from ‹(p,ins,outs) ∈ set procs› have "distinct ins" by(rule distinct_formal_ins)
with ‹i < length ins› ‹length fs = length ins›
have "(Map.empty(ins [:=] params fs (fst cf))) (ins!i) = (params fs (fst cf))!i"
"(Map.empty(ins [:=] params fs (fst cf'))) (ins!i) = (params fs (fst cf'))!i"
by(fastforce intro:fun_upds_nth)+
with eqs ‹kind a = Q:r↪⇘p⇙fs› params
show ?thesis by simp
qed
lemma CFG_call_edge_no_param:
assumes "valid_edge a" and "kind a = Q:r↪⇘p⇙fs" and "V ∉ set ins"
and "(p,ins,outs) ∈ set procs" and "pred (kind a) s"
shows "state_val (transfer (kind a) s) V = None"
proof -
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹(p,ins,outs) ∈ set procs›
have [simp]:"(THE ins. ∃outs. (p,ins,outs) ∈ set procs) = ins"
by(rule formal_in_THE)
from ‹pred (kind a) s› obtain cf cfs where [simp]:"s = cf#cfs" by(cases s) auto
from ‹V ∉ set ins› have "(Map.empty(ins [:=] params fs (fst cf))) V = None"
by(auto dest:fun_upds_notin)
with ‹kind a = Q:r↪⇘p⇙fs› show ?thesis by simp
qed
lemma CFG_return_edge_param_out:
assumes "valid_edge a" and "kind a = Q↩⇘p⇙f" and "i < length outs"
and "(p,ins,outs) ∈ set procs" and "state_val s (outs!i) = state_val s' (outs!i)"
and "s = cf#cfx#cfs" and "s' = cf'#cfx'#cfs'"
shows "state_val (transfer (kind a) s) ((ParamDefs (targetnode a))!i) =
state_val (transfer (kind a) s') ((ParamDefs (targetnode a))!i)"
proof -
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f› ‹(p,ins,outs) ∈ set procs›
have [simp]:"(THE outs. ∃ins. (p,ins,outs) ∈ set procs) = outs"
by(rule formal_out_THE)
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f› ‹(p,ins,outs) ∈ set procs› ‹s = cf#cfx#cfs›
have transfer:"fst (hd (transfer (kind a) s)) =
(fst cfx)(ParamDefs (targetnode a) [:=] map (fst cf) outs)"
by(fastforce intro:CFG_return_edge_fun)
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f› ‹(p,ins,outs) ∈ set procs› ‹s' = cf'#cfx'#cfs'›
have transfer':"fst (hd (transfer (kind a) s')) =
(fst cfx')(ParamDefs (targetnode a) [:=] map (fst cf') outs)"
by(fastforce intro:CFG_return_edge_fun)
from ‹state_val s (outs!i) = state_val s' (outs!i)› ‹i < length outs›
‹s = cf#cfx#cfs› ‹s' = cf'#cfx'#cfs'›
have "(fst cf) (outs!i) = (fst cf') (outs!i)" by simp
from ‹valid_edge a› have "distinct (ParamDefs (targetnode a))"
by(fastforce intro:distinct_ParamDefs)
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f› ‹(p,ins,outs) ∈ set procs›
have "length(ParamDefs (targetnode a)) = length outs"
by(fastforce intro:ParamDefs_return_target_length)
with ‹i < length outs› ‹distinct (ParamDefs (targetnode a))›
have "(fst cfx)(ParamDefs (targetnode a) [:=] map (fst cf) outs)
((ParamDefs (targetnode a))!i) = (map (fst cf) outs)!i"
and "(fst cfx')(ParamDefs (targetnode a) [:=] map (fst cf') outs)
((ParamDefs (targetnode a))!i) = (map (fst cf') outs)!i"
by(fastforce intro:fun_upds_nth)+
with transfer transfer' ‹(fst cf) (outs!i) = (fst cf') (outs!i)› ‹i < length outs›
show ?thesis by simp
qed
lemma CFG_slp_no_Def_equal:
assumes "n -as→⇘sl⇙* n'" and "valid_edge a" and "a' ∈ get_return_edges a"
and "V ∉ set (ParamDefs (targetnode a'))" and "preds (kinds (a#as@[a'])) s"
shows "state_val (transfers (kinds (a#as@[a'])) s) V = state_val s V"
proof -
from ‹valid_edge a› ‹a' ∈ get_return_edges a›
obtain Q r p fs where "kind a = Q:r↪⇘p⇙fs"
by(fastforce dest!:only_call_get_return_edges)
with ‹valid_edge a› ‹a' ∈ get_return_edges a› obtain Q' f' where "kind a' = Q'↩⇘p⇙f'"
by(fastforce dest!:call_return_edges)
from ‹valid_edge a› ‹a' ∈ get_return_edges a› have "valid_edge a'"
by(rule get_return_edges_valid)
from ‹preds (kinds (a#as@[a'])) s› obtain cf cfs where [simp]:"s = cf#cfs"
by(cases s,auto simp:kinds_def)
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› obtain ins outs
where "(p,ins,outs) ∈ set procs" by(fastforce dest!:callee_in_procs)
from ‹kind a = Q:r↪⇘p⇙fs› obtain cfx where "transfer (kind a) s = cfx#cf#cfs"
by simp
moreover
from ‹n -as→⇘sl⇙* n'› obtain cfx'
where "transfers (kinds as) (cfx#cf#cfs) = cfx'#cf#cfs"
by(fastforce elim:slp_callstack_length_equal)
moreover
from ‹kind a' = Q'↩⇘p⇙f'› ‹valid_edge a'› ‹(p,ins,outs) ∈ set procs›
have "fst (hd (transfer (kind a') (cfx'#cf#cfs))) =
(fst cf)(ParamDefs (targetnode a') [:=] map (fst cfx') outs)"
by(simp,simp only:formal_out_THE,fastforce intro:CFG_return_edge_fun)
ultimately have "fst (hd (transfers (kinds (a#as@[a'])) s)) =
(fst cf)(ParamDefs (targetnode a') [:=] map (fst cfx') outs)"
by(simp add:kinds_def transfers_split)
with ‹V ∉ set (ParamDefs (targetnode a'))› show ?thesis
by(simp add:fun_upds_notin)
qed
lemma [dest!]: "V ∈ Use (_Entry_) ⟹ False"
by(simp add:Entry_empty)
lemma [dest!]: "V ∈ Def (_Entry_) ⟹ False"
by(simp add:Entry_empty)
lemma CFG_intra_path_no_Def_equal:
assumes "n -as→⇩ι* n'" and "∀n ∈ set (sourcenodes as). V ∉ Def n"
and "preds (kinds as) s"
shows "state_val (transfers (kinds as) s) V = state_val s V"
proof -
from ‹n -as→⇩ι* n'› have "n -as→* n'" and "∀a ∈ set as. intra_kind (kind a)"
by(simp_all add:intra_path_def)
from this ‹∀n ∈ set (sourcenodes as). V ∉ Def n› ‹preds (kinds as) s›
have "state_val (transfers (kinds as) s) V = state_val s V"
proof(induct arbitrary:s rule:path.induct)
case (empty_path n)
thus ?case by(simp add:sourcenodes_def kinds_def)
next
case (Cons_path n'' as n' a n)
note IH = ‹⋀s. ⟦∀a∈set as. intra_kind (kind a);
∀n∈set (sourcenodes as). V ∉ Def n; preds (kinds as) s⟧
⟹ state_val (transfers (kinds as) s) V = state_val s V›
from ‹preds (kinds (a#as)) s› have "pred (kind a) s"
and "preds (kinds as) (transfer (kind a) s)" by(simp_all add:kinds_def)
from ‹∀n∈set (sourcenodes (a#as)). V ∉ Def n›
have noDef:"V ∉ Def (sourcenode a)"
and all:"∀n∈set (sourcenodes as). V ∉ Def n"
by(auto simp:sourcenodes_def)
from ‹∀a∈set (a#as). intra_kind (kind a)›
have "intra_kind (kind a)" and all':"∀a∈set as. intra_kind (kind a)"
by auto
from ‹valid_edge a› noDef ‹intra_kind (kind a)› ‹pred (kind a) s›
have "state_val (transfer (kind a) s) V = state_val s V"
by -(rule CFG_intra_edge_no_Def_equal)
with IH[OF all' all ‹preds (kinds as) (transfer (kind a) s)›] show ?case
by(simp add:kinds_def)
qed
thus ?thesis by blast
qed
lemma slpa_preds:
"⟦same_level_path_aux cs as; s = cfsx@cf#cfs; s' = cfsx@cf#cfs';
length cfs = length cfs'; ∀a ∈ set as. valid_edge a; length cs = length cfsx;
preds (kinds as) s⟧
⟹ preds (kinds as) s'"
proof(induct arbitrary:s s' cf cfsx rule:slpa_induct)
case (slpa_empty cs) thus ?case by(simp add:kinds_def)
next
case (slpa_intra cs a as)
note IH = ‹⋀s s' cf cfsx. ⟦s = cfsx@cf#cfs; s' = cfsx@cf#cfs';
length cfs = length cfs'; ∀a ∈ set as. valid_edge a; length cs = length cfsx;
preds (kinds as) s⟧ ⟹ preds (kinds as) s'›
from ‹∀a∈set (a#as). valid_edge a› have "valid_edge a"
and "∀a ∈ set as. valid_edge a" by simp_all
from ‹preds (kinds (a#as)) s› have "pred (kind a) s"
and "preds (kinds as) (transfer (kind a) s)" by(simp_all add:kinds_def)
show ?case
proof(cases cfsx)
case Nil
with ‹length cs = length cfsx› have "length cs = length []" by simp
from Nil ‹s = cfsx@cf#cfs› ‹s' = cfsx@cf#cfs'› ‹intra_kind (kind a)›
obtain cfx where "transfer (kind a) s = []@cfx#cfs"
and "transfer (kind a) s' = []@cfx#cfs'"
by(cases "kind a",auto simp:kinds_def intra_kind_def)
from IH[OF this ‹length cfs = length cfs'› ‹∀a ∈ set as. valid_edge a›
‹length cs = length []› ‹preds (kinds as) (transfer (kind a) s)›]
have "preds (kinds as) (transfer (kind a) s')" .
moreover
from Nil ‹valid_edge a› ‹pred (kind a) s› ‹s = cfsx@cf#cfs› ‹s' = cfsx@cf#cfs'›
‹length cfs = length cfs'›
have "pred (kind a) s'" by(fastforce intro:CFG_edge_Uses_pred_equal)
ultimately show ?thesis by(simp add:kinds_def)
next
case (Cons x xs)
with ‹s = cfsx@cf#cfs› ‹s' = cfsx@cf#cfs'› ‹intra_kind (kind a)›
obtain cfx where "transfer (kind a) s = (cfx#xs)@cf#cfs"
and "transfer (kind a) s' = (cfx#xs)@cf#cfs'"
by(cases "kind a",auto simp:kinds_def intra_kind_def)
from IH[OF this ‹length cfs = length cfs'› ‹∀a ∈ set as. valid_edge a› _
‹preds (kinds as) (transfer (kind a) s)›] ‹length cs = length cfsx› Cons
have "preds (kinds as) (transfer (kind a) s')" by simp
moreover
from Cons ‹valid_edge a› ‹pred (kind a) s› ‹s = cfsx@cf#cfs› ‹s' = cfsx@cf#cfs'›
‹length cfs = length cfs'›
have "pred (kind a) s'" by(fastforce intro:CFG_edge_Uses_pred_equal)
ultimately show ?thesis by(simp add:kinds_def)
qed
next
case (slpa_Call cs a as Q r p fs)
note IH = ‹⋀s s' cf cfsx. ⟦s = cfsx@cf#cfs; s' = cfsx@cf#cfs';
length cfs = length cfs'; ∀a ∈ set as. valid_edge a; length (a#cs) = length cfsx;
preds (kinds as) s⟧ ⟹ preds (kinds as) s'›
from ‹∀a∈set (a#as). valid_edge a› have "valid_edge a"
and "∀a ∈ set as. valid_edge a" by simp_all
from ‹preds (kinds (a#as)) s› have "pred (kind a) s"
and "preds (kinds as) (transfer (kind a) s)" by(simp_all add:kinds_def)
from ‹kind a = Q:r↪⇘p⇙fs› ‹s = cfsx@cf#cfs› ‹s' = cfsx@cf#cfs'› obtain cfx
where "transfer (kind a) s = (cfx#cfsx)@cf#cfs"
and "transfer (kind a) s' = (cfx#cfsx)@cf#cfs'" by(cases cfsx) auto
from IH[OF this ‹length cfs = length cfs'› ‹∀a ∈ set as. valid_edge a› _
‹preds (kinds as) (transfer (kind a) s)›] ‹length cs = length cfsx›
have "preds (kinds as) (transfer (kind a) s')" by simp
moreover
from ‹valid_edge a› ‹pred (kind a) s› ‹s = cfsx@cf#cfs› ‹s' = cfsx@cf#cfs'›
‹length cfs = length cfs'› have "pred (kind a) s'"
by(cases cfsx)(auto intro:CFG_edge_Uses_pred_equal)
ultimately show ?case by(simp add:kinds_def)
next
case (slpa_Return cs a as Q p f c' cs')
note IH = ‹⋀s s' cf cfsx. ⟦s = cfsx@cf#cfs; s' = cfsx@cf#cfs';
length cfs = length cfs'; ∀a ∈ set as. valid_edge a; length cs' = length cfsx;
preds (kinds as) s⟧ ⟹ preds (kinds as) s'›
from ‹∀a∈set (a#as). valid_edge a› have "valid_edge a"
and "∀a ∈ set as. valid_edge a" by simp_all
from ‹preds (kinds (a#as)) s› have "pred (kind a) s"
and "preds (kinds as) (transfer (kind a) s)" by(simp_all add:kinds_def)
show ?case
proof(cases cs')
case Nil
with ‹cs = c'#cs'› ‹s = cfsx@cf#cfs› ‹s' = cfsx@cf#cfs'›
‹length cs = length cfsx›
obtain cf' where "s = cf'#cf#cfs" and "s' = cf'#cf#cfs'" by(cases cfsx) auto
with ‹kind a = Q↩⇘p⇙f› obtain cf'' where "transfer (kind a) s = []@cf''#cfs"
and "transfer (kind a) s' = []@cf''#cfs'" by auto
from IH[OF this ‹length cfs = length cfs'› ‹∀a ∈ set as. valid_edge a› _
‹preds (kinds as) (transfer (kind a) s)›] Nil
have "preds (kinds as) (transfer (kind a) s')" by simp
moreover
from ‹valid_edge a› ‹pred (kind a) s› ‹s = cfsx@cf#cfs› ‹s' = cfsx@cf#cfs'›
‹length cfs = length cfs'› have "pred (kind a) s'"
by(cases cfsx)(auto intro:CFG_edge_Uses_pred_equal)
ultimately show ?thesis by(simp add:kinds_def)
next
case (Cons cx csx)
with ‹cs = c'#cs'› ‹length cs = length cfsx› ‹s = cfsx@cf#cfs› ‹s' = cfsx@cf#cfs'›
obtain x x' xs where "s = (x#x'#xs)@cf#cfs" and "s' = (x#x'#xs)@cf#cfs'"
and "length xs = length csx"
by(cases cfsx,auto,case_tac list,fastforce+)
with ‹kind a = Q↩⇘p⇙f› obtain cf' where "transfer (kind a) s = (cf'#xs)@cf#cfs"
and "transfer (kind a) s' = (cf'#xs)@cf#cfs'"
by fastforce
from IH[OF this ‹length cfs = length cfs'› ‹∀a ∈ set as. valid_edge a› _
‹preds (kinds as) (transfer (kind a) s)›] Cons ‹length xs = length csx›
have "preds (kinds as) (transfer (kind a) s')" by simp
moreover
from ‹valid_edge a› ‹pred (kind a) s› ‹s = cfsx@cf#cfs› ‹s' = cfsx@cf#cfs'›
‹length cfs = length cfs'› have "pred (kind a) s'"
by(cases cfsx)(auto intro:CFG_edge_Uses_pred_equal)
ultimately show ?thesis by(simp add:kinds_def)
qed
qed
lemma slp_preds:
assumes "n -as→⇘sl⇙* n'" and "preds (kinds as) (cf#cfs)"
and "length cfs = length cfs'"
shows "preds (kinds as) (cf#cfs')"
proof -
from ‹n -as→⇘sl⇙* n'› have "n -as→* n'" and "same_level_path_aux [] as"
by(simp_all add:slp_def same_level_path_def)
from ‹n -as→* n'› have "∀a ∈ set as. valid_edge a" by(rule path_valid_edges)
with ‹same_level_path_aux [] as› ‹preds (kinds as) (cf#cfs)›
‹length cfs = length cfs'›
show ?thesis by(fastforce elim!:slpa_preds)
qed
end
end
Theory CFGExit_wf
theory CFGExit_wf imports CFGExit CFG_wf begin
subsection ‹New well-formedness lemmas using ‹(_Exit_)››
locale CFGExit_wf = CFGExit sourcenode targetnode kind valid_edge Entry
get_proc get_return_edges procs Main Exit +
CFG_wf sourcenode targetnode kind valid_edge Entry
get_proc get_return_edges procs Main Def Use ParamDefs ParamUses
for sourcenode :: "'edge ⇒ 'node" and targetnode :: "'edge ⇒ 'node"
and kind :: "'edge ⇒ ('var,'val,'ret,'pname) edge_kind"
and valid_edge :: "'edge ⇒ bool"
and Entry :: "'node" ("'('_Entry'_')") and get_proc :: "'node ⇒ 'pname"
and get_return_edges :: "'edge ⇒ 'edge set"
and procs :: "('pname × 'var list × 'var list) list" and Main :: "'pname"
and Exit::"'node" ("'('_Exit'_')")
and Def :: "'node ⇒ 'var set" and Use :: "'node ⇒ 'var set"
and ParamDefs :: "'node ⇒ 'var list"
and ParamUses :: "'node ⇒ 'var set list" +
assumes Exit_empty:"Def (_Exit_) = {} ∧ Use (_Exit_) = {}"
begin
lemma Exit_Use_empty [dest!]: "V ∈ Use (_Exit_) ⟹ False"
by(simp add:Exit_empty)
lemma Exit_Def_empty [dest!]: "V ∈ Def (_Exit_) ⟹ False"
by(simp add:Exit_empty)
end
end
Theory SemanticsCFG
section ‹CFG and semantics conform›
theory SemanticsCFG imports CFG begin
locale CFG_semantics_wf = CFG sourcenode targetnode kind valid_edge Entry
get_proc get_return_edges procs Main
for sourcenode :: "'edge ⇒ 'node" and targetnode :: "'edge ⇒ 'node"
and kind :: "'edge ⇒ ('var,'val,'ret,'pname) edge_kind"
and valid_edge :: "'edge ⇒ bool"
and Entry :: "'node" ("'('_Entry'_')") and get_proc :: "'node ⇒ 'pname"
and get_return_edges :: "'edge ⇒ 'edge set"
and procs :: "('pname × 'var list × 'var list) list" and Main :: "'pname" +
fixes sem::"'com ⇒ ('var ⇀ 'val) list ⇒ 'com ⇒ ('var ⇀ 'val) list ⇒ bool"
("((1⟨_,/_⟩) ⇒/ (1⟨_,/_⟩))" [0,0,0,0] 81)
fixes identifies::"'node ⇒ 'com ⇒ bool" ("_ ≜ _" [51,0] 80)
assumes fundamental_property:
"⟦n ≜ c; ⟨c,[cf]⟩ ⇒ ⟨c',s'⟩⟧ ⟹
∃n' as. n -as→⇩√* n' ∧ n' ≜ c' ∧ preds (kinds as) [(cf,undefined)] ∧
transfers (kinds as) [(cf,undefined)] = cfs' ∧ map fst cfs' = s'"
end
Theory ReturnAndCallNodes
section ‹Return and their corresponding call nodes›
theory ReturnAndCallNodes imports CFG begin
context CFG begin
subsection ‹Defining ‹return_node››
definition return_node :: "'node ⇒ bool"
where "return_node n ≡ ∃a a'. valid_edge a ∧ n = targetnode a ∧
valid_edge a' ∧ a ∈ get_return_edges a'"
lemma return_node_determines_call_node:
assumes "return_node n"
shows "∃!n'. ∃a a'. valid_edge a ∧ n' = sourcenode a ∧ valid_edge a' ∧
a' ∈ get_return_edges a ∧ n = targetnode a'"
proof(rule ex_ex1I)
from ‹return_node n›
show "∃n' a a'. valid_edge a ∧ n' = sourcenode a ∧ valid_edge a' ∧
a' ∈ get_return_edges a ∧ n = targetnode a'"
by(simp add:return_node_def) blast
next
fix n' nx
assume "∃a a'. valid_edge a ∧ n' = sourcenode a ∧ valid_edge a' ∧
a' ∈ get_return_edges a ∧ n = targetnode a'"
and "∃a a'. valid_edge a ∧ nx = sourcenode a ∧ valid_edge a' ∧
a' ∈ get_return_edges a ∧ n = targetnode a'"
then obtain a a' ax ax' where "valid_edge a" and "n' = sourcenode a"
and "valid_edge a'" and "a' ∈ get_return_edges a"
and "n = targetnode a'" and "valid_edge ax" and "nx = sourcenode ax"
and "valid_edge ax'" and "ax' ∈ get_return_edges ax"
and "n = targetnode ax'"
by blast
from ‹valid_edge a› ‹a' ∈ get_return_edges a› have "valid_edge a'"
by(rule get_return_edges_valid)
from ‹valid_edge a› ‹a' ∈ get_return_edges a› obtain a''
where intra_edge1:"valid_edge a''" "sourcenode a'' = sourcenode a"
"targetnode a'' = targetnode a'" "kind a'' = (λcf. False)⇩√"
by(fastforce dest:call_return_node_edge)
from ‹valid_edge ax› ‹ax' ∈ get_return_edges ax› obtain ax''
where intra_edge2:"valid_edge ax''" "sourcenode ax'' = sourcenode ax"
"targetnode ax'' = targetnode ax'" "kind ax'' = (λcf. False)⇩√"
by(fastforce dest:call_return_node_edge)
from ‹valid_edge a› ‹a' ∈ get_return_edges a›
obtain Q r p fs where "kind a = Q:r↪⇘p⇙fs"
by(fastforce dest!:only_call_get_return_edges)
with ‹valid_edge a› ‹a' ∈ get_return_edges a› obtain Q' p f'
where "kind a' = Q'↩⇘p⇙f'" by(fastforce dest!:call_return_edges)
with ‹valid_edge a'›
have "∃!a''. valid_edge a'' ∧ targetnode a'' = targetnode a' ∧ intra_kind(kind a'')"
by(rule return_only_one_intra_edge)
with intra_edge1 intra_edge2 ‹n = targetnode a'› ‹n = targetnode ax'›
have "a'' = ax''" by(fastforce simp:intra_kind_def)
with ‹sourcenode a'' = sourcenode a› ‹sourcenode ax'' = sourcenode ax›
‹n' = sourcenode a› ‹nx = sourcenode ax›
show "n' = nx" by simp
qed
lemma return_node_THE_call_node:
"⟦return_node n; valid_edge a; valid_edge a'; a' ∈ get_return_edges a;
n = targetnode a'⟧
⟹ (THE n'. ∃a a'. valid_edge a ∧ n' = sourcenode a ∧ valid_edge a' ∧
a' ∈ get_return_edges a ∧ n = targetnode a') = sourcenode a"
by(fastforce intro!:the1_equality return_node_determines_call_node)
subsection ‹Defining call nodes belonging to a certain ‹return_node››
definition call_of_return_node :: "'node ⇒ 'node ⇒ bool"
where "call_of_return_node n n' ≡ ∃a a'. return_node n ∧
valid_edge a ∧ n' = sourcenode a ∧ valid_edge a' ∧
a' ∈ get_return_edges a ∧ n = targetnode a'"
lemma return_node_call_of_return_node:
"return_node n ⟹ ∃!n'. call_of_return_node n n'"
by -(frule return_node_determines_call_node,unfold call_of_return_node_def,simp)
lemma call_of_return_nodes_det [dest]:
assumes "call_of_return_node n n'" and "call_of_return_node n n''"
shows "n' = n''"
proof -
from ‹call_of_return_node n n'› have "return_node n"
by(simp add:call_of_return_node_def)
hence "∃!n'. call_of_return_node n n'" by(rule return_node_call_of_return_node)
with ‹call_of_return_node n n'› ‹call_of_return_node n n''›
show ?thesis by auto
qed
lemma get_return_edges_call_of_return_nodes:
"⟦valid_call_list cs m; valid_return_list rs m;
∀i < length rs. rs!i ∈ get_return_edges (cs!i); length rs = length cs⟧
⟹ ∀i<length cs. call_of_return_node (targetnodes rs!i) (sourcenode (cs!i))"
proof(induct cs arbitrary:m rs)
case Nil thus ?case by fastforce
next
case (Cons c' cs')
note IH = ‹⋀m rs. ⟦valid_call_list cs' m; valid_return_list rs m;
∀i<length rs. rs ! i ∈ get_return_edges (cs' ! i); length rs = length cs'⟧
⟹ ∀i<length cs'. call_of_return_node (targetnodes rs ! i) (sourcenode (cs'!i))›
from ‹length rs = length (c' # cs')› obtain r' rs' where "rs = r' # rs'"
and "length rs' = length cs'" by(cases rs) auto
with ‹∀i<length rs. rs ! i ∈ get_return_edges ((c' # cs') ! i)›
have "∀i<length rs'. rs' ! i ∈ get_return_edges (cs' ! i)"
and "r' ∈ get_return_edges c'" by auto
from ‹valid_call_list (c'#cs') m› have "valid_edge c'"
by(fastforce simp:valid_call_list_def)
from this ‹r' ∈ get_return_edges c'›
have "get_proc (sourcenode c') = get_proc (targetnode r')"
by(rule get_proc_get_return_edge)
from ‹valid_call_list (c'#cs') m›
have "valid_call_list cs' (sourcenode c')"
apply(clarsimp simp:valid_call_list_def)
apply(hypsubst_thin)
apply(erule_tac x="c'#cs'" in allE) apply clarsimp
by(case_tac cs')(auto simp:sourcenodes_def)
from ‹valid_return_list rs m› ‹rs = r' # rs'›
‹get_proc (sourcenode c') = get_proc (targetnode r')›
have "valid_return_list rs' (sourcenode c')"
apply(clarsimp simp:valid_return_list_def)
apply(erule_tac x="r'#cs'" in allE) apply clarsimp
by(case_tac cs')(auto simp:targetnodes_def)
from IH[OF ‹valid_call_list cs' (sourcenode c')›
‹valid_return_list rs' (sourcenode c')›
‹∀i<length rs'. rs' ! i ∈ get_return_edges (cs' ! i)› ‹length rs' = length cs'›]
have all:"∀i<length cs'.
call_of_return_node (targetnodes rs' ! i) (sourcenode (cs' ! i))" .
from ‹valid_edge c'› ‹r' ∈ get_return_edges c'› have "valid_edge r'"
by(rule get_return_edges_valid)
from ‹valid_edge r'› ‹valid_edge c'› ‹r' ∈ get_return_edges c'›
have "return_node (targetnode r')" by(fastforce simp:return_node_def)
with ‹valid_edge c'› ‹r' ∈ get_return_edges c'› ‹valid_edge r'›
have "call_of_return_node (targetnode r') (sourcenode c')"
by(simp add:call_of_return_node_def) blast
with all ‹rs = r' # rs'› show ?case
by auto(case_tac i,auto simp:targetnodes_def)
qed
end
end
Theory Observable
section ‹Observable Sets of Nodes›
theory Observable imports ReturnAndCallNodes begin
context CFG begin
subsection ‹Intraprocedural observable sets›
inductive_set obs_intra :: "'node ⇒ 'node set ⇒ 'node set"
for n::"'node" and S::"'node set"
where obs_intra_elem:
"⟦n -as→⇩ι* n'; ∀nx ∈ set(sourcenodes as). nx ∉ S; n' ∈ S⟧ ⟹ n' ∈ obs_intra n S"
lemma obs_intraE:
assumes "n' ∈ obs_intra n S"
obtains as where "n -as→⇩ι* n'" and "∀nx ∈ set(sourcenodes as). nx ∉ S" and "n' ∈ S"
using ‹n' ∈ obs_intra n S›
by(fastforce elim:obs_intra.cases)
lemma n_in_obs_intra:
assumes "valid_node n" and "n ∈ S" shows "obs_intra n S = {n}"
proof -
from ‹valid_node n› have "n -[]→* n" by(rule empty_path)
hence "n -[]→⇩ι* n" by(simp add:intra_path_def)
with ‹n ∈ S› have "n ∈ obs_intra n S"
by(fastforce elim:obs_intra_elem simp:sourcenodes_def)
{ fix n' assume "n' ∈ obs_intra n S"
have "n' = n"
proof(rule ccontr)
assume "n' ≠ n"
from ‹n' ∈ obs_intra n S› obtain as where "n -as→⇩ι* n'"
and "∀nx ∈ set(sourcenodes as). nx ∉ S"
and "n' ∈ S" by(fastforce elim:obs_intra.cases)
from ‹n -as→⇩ι* n'› have "n -as→* n'" by(simp add:intra_path_def)
from this ‹∀nx ∈ set(sourcenodes as). nx ∉ S› ‹n' ≠ n› ‹n ∈ S›
show False
proof(induct rule:path.induct)
case (Cons_path n'' as n' a n)
from ‹∀nx∈set (sourcenodes (a#as)). nx ∉ S› ‹sourcenode a = n›
have "n ∉ S" by(simp add:sourcenodes_def)
with ‹n ∈ S› show False by simp
qed simp
qed }
with ‹n ∈ obs_intra n S› show ?thesis by fastforce
qed
lemma in_obs_intra_valid:
assumes "n' ∈ obs_intra n S" shows "valid_node n" and "valid_node n'"
using ‹n' ∈ obs_intra n S›
by(auto elim!:obs_intraE intro:path_valid_node simp:intra_path_def)
lemma edge_obs_intra_subset:
assumes "valid_edge a" and "intra_kind (kind a)" and "sourcenode a ∉ S"
shows "obs_intra (targetnode a) S ⊆ obs_intra (sourcenode a) S"
proof
fix n assume "n ∈ obs_intra (targetnode a) S"
then obtain as where "targetnode a -as→⇩ι* n"
and all:"∀nx ∈ set(sourcenodes as). nx ∉ S" and "n ∈ S" by(erule obs_intraE)
from ‹valid_edge a› ‹intra_kind (kind a)› ‹targetnode a -as→⇩ι* n›
have "sourcenode a -[a]@as→⇩ι* n" by(fastforce intro:Cons_path simp:intra_path_def)
moreover
from all ‹sourcenode a ∉ S› have "∀nx ∈ set(sourcenodes (a#as)). nx ∉ S"
by(simp add:sourcenodes_def)
ultimately show "n ∈ obs_intra (sourcenode a) S" using ‹n ∈ S›
by(fastforce intro:obs_intra_elem)
qed
lemma path_obs_intra_subset:
assumes "n -as→⇩ι* n'" and "∀n' ∈ set(sourcenodes as). n' ∉ S"
shows "obs_intra n' S ⊆ obs_intra n S"
proof -
from ‹n -as→⇩ι* n'› have "n -as→* n'" and "∀a ∈ set as. intra_kind (kind a)"
by(simp_all add:intra_path_def)
from this ‹∀n' ∈ set(sourcenodes as). n' ∉ S› show ?thesis
proof(induct rule:path.induct)
case (Cons_path n'' as n' a n)
note IH = ‹⟦∀a∈set as. intra_kind (kind a); ∀n'∈set (sourcenodes as). n' ∉ S⟧
⟹ obs_intra n' S ⊆ obs_intra n'' S›
from ‹∀n'∈set (sourcenodes (a#as)). n' ∉ S›
have all:"∀n'∈set (sourcenodes as). n' ∉ S" and "sourcenode a ∉ S"
by(simp_all add:sourcenodes_def)
from ‹∀a ∈ set (a#as). intra_kind (kind a)›
have "intra_kind (kind a)" and "∀a ∈ set as. intra_kind (kind a)"
by(simp_all add:intra_path_def)
from IH[OF ‹∀a ∈ set as. intra_kind (kind a)› all]
have "obs_intra n' S ⊆ obs_intra n'' S" .
from ‹valid_edge a› ‹intra_kind (kind a)› ‹targetnode a = n''›
‹sourcenode a = n› ‹sourcenode a ∉ S›
have "obs_intra n'' S ⊆ obs_intra n S" by(fastforce dest:edge_obs_intra_subset)
with ‹obs_intra n' S ⊆ obs_intra n'' S› show ?case by fastforce
qed simp
qed
lemma path_ex_obs_intra:
assumes "n -as→⇩ι* n'" and "n' ∈ S"
obtains m where "m ∈ obs_intra n S"
proof(atomize_elim)
show "∃m. m ∈ obs_intra n S"
proof(cases "∀nx ∈ set(sourcenodes as). nx ∉ S")
case True
with ‹n -as→⇩ι* n'› ‹n' ∈ S› have "n' ∈ obs_intra n S" by -(rule obs_intra_elem)
thus ?thesis by fastforce
next
case False
hence "∃nx ∈ set(sourcenodes as). nx ∈ S" by fastforce
then obtain nx ns ns' where "sourcenodes as = ns@nx#ns'"
and "nx ∈ S" and "∀n' ∈ set ns. n' ∉ S"
by(fastforce elim!:split_list_first_propE)
from ‹sourcenodes as = ns@nx#ns'› obtain as' a as''
where "ns = sourcenodes as'"
and "as = as'@a#as''" and "sourcenode a = nx"
by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
with ‹n -as→⇩ι* n'› have "n -as'→⇩ι* nx"
by(fastforce dest:path_split simp:intra_path_def)
with ‹nx ∈ S› ‹∀n' ∈ set ns. n' ∉ S› ‹ns = sourcenodes as'›
have "nx ∈ obs_intra n S" by(fastforce intro:obs_intra_elem)
thus ?thesis by fastforce
qed
qed
subsection ‹Interprocedural observable sets restricted to the slice›
fun obs :: "'node list ⇒ 'node set ⇒ 'node list set"
where "obs [] S = {}"
| "obs (n#ns) S = (let S' = obs_intra n S in
(if (S' = {} ∨ (∃n' ∈ set ns. ∃nx. call_of_return_node n' nx ∧ nx ∉ S))
then obs ns S else (λnx. nx#ns) ` S'))"
lemma obsI:
assumes "n' ∈ obs_intra n S"
and "∀nx ∈ set nsx'. ∃nx'. call_of_return_node nx nx' ∧ nx' ∈ S"
shows "⟦ns = nsx@n#nsx'; ∀xs x xs'. nsx = xs@x#xs' ∧ obs_intra x S ≠ {}
⟶ (∃x'' ∈ set (xs'@[n]). ∃nx. call_of_return_node x'' nx ∧ nx ∉ S)⟧
⟹ n'#nsx' ∈ obs ns S"
proof(induct ns arbitrary:nsx)
case (Cons x xs)
note IH = ‹⋀nsx. ⟦xs = nsx@n#nsx';
∀xs x xs'. nsx = xs @ x # xs' ∧ obs_intra x S ≠ {} ⟶
(∃x''∈set (xs'@[n]). ∃nx. call_of_return_node x'' nx ∧ nx ∉ S)⟧
⟹ n'#nsx' ∈ obs xs S›
note nsx = ‹∀xs x xs'. nsx = xs @ x # xs' ∧ obs_intra x S ≠ {} ⟶
(∃x''∈set (xs' @ [n]). ∃nx. call_of_return_node x'' nx ∧ nx ∉ S)›
show ?case
proof(cases nsx)
case Nil
with ‹x#xs = nsx@n#nsx'› have "n = x" and "xs = nsx'" by simp_all
with ‹n' ∈ obs_intra n S›
‹∀nx∈set nsx'. ∃nx'. call_of_return_node nx nx' ∧ nx' ∈ S›
show ?thesis by(fastforce simp:Let_def)
next
case (Cons z zs)
with ‹x#xs = nsx@n#nsx'› have [simp]:"x = z" "xs = zs@n#nsx'" by simp_all
from nsx Cons
have "∀xs x xs'. zs = xs @ x # xs' ∧ obs_intra x S ≠ {} ⟶
(∃x''∈set (xs' @ [n]). ∃nx. call_of_return_node x'' nx ∧ nx ∉ S)"
by clarsimp(erule_tac x="z#xs" in allE,auto)
from IH[OF ‹xs = zs@n#nsx'› this] have "n'#nsx' ∈ obs xs S" by simp
show ?thesis
proof(cases "obs_intra z S = {}")
case True
with Cons ‹n'#nsx' ∈ obs xs S› show ?thesis by(simp add:Let_def)
next
case False
from nsx Cons
have "obs_intra z S ≠ {} ⟶
(∃x''∈set (zs @ [n]). ∃nx. call_of_return_node x'' nx ∧ nx ∉ S)"
by clarsimp
with False have "∃x''∈set (zs @ [n]). ∃nx. call_of_return_node x'' nx ∧ nx ∉ S"
by simp
with ‹xs = zs@n#nsx'›
have "∃n' ∈ set xs. ∃nx. call_of_return_node n' nx ∧ nx ∉ S" by fastforce
with Cons ‹n'#nsx' ∈ obs xs S› show ?thesis by(simp add:Let_def)
qed
qed
qed simp
lemma obsE [consumes 2]:
assumes "ns' ∈ obs ns S" and "∀n ∈ set (tl ns). return_node n"
obtains nsx n nsx' n' where "ns = nsx@n#nsx'" and "ns' = n'#nsx'"
and "n' ∈ obs_intra n S"
and "∀nx ∈ set nsx'. ∃nx'. call_of_return_node nx nx' ∧ nx' ∈ S"
and "∀xs x xs'. nsx = xs@x#xs' ∧ obs_intra x S ≠ {}
⟶ (∃x'' ∈ set (xs'@[n]). ∃nx. call_of_return_node x'' nx ∧ nx ∉ S)"
proof(atomize_elim)
from ‹ns' ∈ obs ns S› ‹∀n ∈ set (tl ns). return_node n›
show "∃nsx n nsx' n'. ns = nsx @ n # nsx' ∧ ns' = n' # nsx' ∧
n' ∈ obs_intra n S ∧ (∀nx∈set nsx'. ∃nx'. call_of_return_node nx nx' ∧ nx' ∈ S) ∧
(∀xs x xs'. nsx = xs @ x # xs' ∧ obs_intra x S ≠ {} ⟶
(∃x''∈set (xs' @ [n]). ∃nx. call_of_return_node x'' nx ∧ nx ∉ S))"
proof(induct ns)
case Nil thus ?case by simp
next
case (Cons nx ns'')
note IH = ‹⟦ns' ∈ obs ns'' S; ∀a∈set (tl ns''). return_node a⟧
⟹ ∃nsx n nsx' n'. ns'' = nsx @ n # nsx' ∧ ns' = n' # nsx' ∧
n' ∈ obs_intra n S ∧
(∀nx∈set nsx'. ∃nx'. call_of_return_node nx nx' ∧ nx' ∈ S) ∧
(∀xs x xs'. nsx = xs @ x # xs' ∧ obs_intra x S ≠ {} ⟶
(∃x''∈set (xs' @ [n]). ∃nx. call_of_return_node x'' nx ∧ nx ∉ S))›
from ‹∀a∈set (tl (nx # ns'')). return_node a› have "∀n ∈ set ns''. return_node n"
by simp
show ?case
proof(cases ns'')
case Nil
with ‹ns' ∈ obs (nx#ns'') S› obtain x where "ns' = [x]" and "x ∈ obs_intra nx S"
by(auto simp:Let_def split:if_split_asm)
with Nil show ?thesis by fastforce
next
case Cons
with ‹∀n ∈ set ns''. return_node n› have "∀a∈set (tl ns''). return_node a"
by simp
show ?thesis
proof(cases "∃n' ∈ set ns''. ∃nx'. call_of_return_node n' nx' ∧ nx' ∉ S")
case True
with ‹ns' ∈ obs (nx#ns'') S› have "ns' ∈ obs ns'' S" by simp
from IH[OF this ‹∀a∈set (tl ns''). return_node a›]
obtain nsx n nsx' n' where split:"ns'' = nsx @ n # nsx'"
"ns' = n' # nsx'" "n' ∈ obs_intra n S"
"∀nx∈set nsx'. ∃nx'. call_of_return_node nx nx' ∧ nx' ∈ S"
and imp:"∀xs x xs'. nsx = xs @ x # xs' ∧ obs_intra x S ≠ {} ⟶
(∃x''∈set (xs' @ [n]). ∃nx. call_of_return_node x'' nx ∧ nx ∉ S)"
by blast
from True ‹ns'' = nsx @ n # nsx'›
‹∀nx∈set nsx'. ∃nx'. call_of_return_node nx nx' ∧ nx' ∈ S›
have "(∃nx'. call_of_return_node n nx' ∧ nx' ∉ S) ∨
(∃n'∈set nsx. ∃nx'. call_of_return_node n' nx' ∧ nx' ∉ S)" by fastforce
thus ?thesis
proof
assume "∃nx'. call_of_return_node n nx' ∧ nx' ∉ S"
with split show ?thesis by clarsimp
next
assume "∃n'∈set nsx. ∃nx'. call_of_return_node n' nx' ∧ nx' ∉ S"
with imp have "∀xs x xs'. nx#nsx = xs @ x # xs' ∧ obs_intra x S ≠ {} ⟶
(∃x''∈set (xs' @ [n]). ∃nx. call_of_return_node x'' nx ∧ nx ∉ S)"
apply clarsimp apply(case_tac xs) apply auto
by(erule_tac x="list" in allE,auto)+
with split Cons show ?thesis by auto
qed
next
case False
hence "∀n'∈set ns''. ∀nx'. call_of_return_node n' nx' ⟶ nx' ∈ S" by simp
show ?thesis
proof(cases "obs_intra nx S = {}")
case True
with ‹ns' ∈ obs (nx#ns'') S› have "ns' ∈ obs ns'' S" by simp
from IH[OF this ‹∀a∈set (tl ns''). return_node a›]
obtain nsx n nsx' n' where split:"ns'' = nsx @ n # nsx'"
"ns' = n' # nsx'" "n' ∈ obs_intra n S"
"∀nx∈set nsx'. ∃nx'. call_of_return_node nx nx' ∧ nx' ∈ S"
and imp:"∀xs x xs'. nsx = xs @ x # xs' ∧ obs_intra x S ≠ {} ⟶
(∃x''∈set (xs' @ [n]). ∃nx. call_of_return_node x'' nx ∧ nx ∉ S)"
by blast
from True imp Cons
have "∀xs x xs'. nx#nsx = xs @ x # xs' ∧ obs_intra x S ≠ {} ⟶
(∃x''∈set (xs' @ [n]). ∃nx. call_of_return_node x'' nx ∧ nx ∉ S)"
by clarsimp (hypsubst_thin,case_tac xs,clarsimp+,erule_tac x="list" in allE,auto)
with split Cons show ?thesis by auto
next
case False
with ‹∀n'∈set ns''. ∀nx'. call_of_return_node n' nx' ⟶ nx' ∈ S›
‹ns' ∈ obs (nx # ns'') S›
obtain nx'' where "ns' = nx''#ns''" and "nx'' ∈ obs_intra nx S"
by(fastforce simp:Let_def split:if_split_asm)
{ fix n' assume "n'∈set ns''"
with ‹∀n ∈ set ns''. return_node n› have "return_node n'" by simp
hence "∃!n''. call_of_return_node n' n''"
by(rule return_node_call_of_return_node)
from ‹n'∈set ns''›
‹∀n'∈set ns''. ∀nx'. call_of_return_node n' nx' ⟶ nx' ∈ S›
have "∀nx'. call_of_return_node n' nx' ⟶ nx' ∈ S" by simp
with ‹∃!n''. call_of_return_node n' n''›
have "∃n''. call_of_return_node n' n'' ∧ n'' ∈ S" by fastforce }
with ‹ns' = nx''#ns''› ‹nx'' ∈ obs_intra nx S› show ?thesis by fastforce
qed
qed
qed
qed
qed
lemma obs_split_det:
assumes "xs@x#xs' = ys@y#ys'"
and "obs_intra x S ≠ {}"
and "∀x' ∈ set xs'. ∃x''. call_of_return_node x' x'' ∧ x'' ∈ S"
and "∀zs z zs'. xs = zs@z#zs' ∧ obs_intra z S ≠ {}
⟶ (∃z'' ∈ set (zs'@[x]). ∃nx. call_of_return_node z'' nx ∧ nx ∉ S)"
and "obs_intra y S ≠ {}"
and "∀y' ∈ set ys'. ∃y''. call_of_return_node y' y'' ∧ y'' ∈ S"
and "∀zs z zs'. ys = zs@z#zs' ∧ obs_intra z S ≠ {}
⟶ (∃z'' ∈ set (zs'@[y]). ∃ny. call_of_return_node z'' ny ∧ ny ∉ S)"
shows "xs = ys ∧ x = y ∧ xs' = ys'"
using assms
proof(induct xs arbitrary:ys)
case Nil
note impy = ‹∀zs z zs'. ys = zs@z#zs' ∧ obs_intra z S ≠ {}
⟶ (∃z'' ∈ set (zs'@[y]). ∃ny. call_of_return_node z'' ny ∧ ny ∉ S)›
show ?case
proof(cases "ys = []")
case True
with Nil ‹[]@x#xs' = ys@y#ys'› show ?thesis by simp
next
case False
with ‹[] @ x # xs' = ys @ y # ys'›
obtain zs where "x#zs = ys" and "xs' = zs@y#ys'" by(auto simp:Cons_eq_append_conv)
from ‹x#zs = ys› ‹obs_intra x S ≠ {}› impy
have "∃z'' ∈ set (zs@[y]). ∃ny. call_of_return_node z'' ny ∧ ny ∉ S"
by blast
with ‹xs' = zs@y#ys'› ‹∀x' ∈ set xs'. ∃x''. call_of_return_node x' x'' ∧ x'' ∈ S›
have False by fastforce
thus ?thesis by simp
qed
next
case (Cons w ws)
note IH = ‹⋀ys. ⟦ws @ x # xs' = ys @ y # ys'; obs_intra x S ≠ {};
∀x'∈set xs'. ∃x''. call_of_return_node x' x'' ∧ x'' ∈ S;
∀zs z zs'. ws = zs @ z # zs' ∧ obs_intra z S ≠ {} ⟶
(∃z''∈set (zs' @ [x]). ∃nx. call_of_return_node z'' nx ∧ nx ∉ S);
obs_intra y S ≠ {}; ∀y'∈set ys'. ∃y''. call_of_return_node y' y'' ∧ y'' ∈ S;
∀zs z zs'. ys = zs @ z # zs' ∧ obs_intra z S ≠ {} ⟶
(∃z''∈set (zs' @ [y]). ∃ny. call_of_return_node z'' ny ∧ ny ∉ S)⟧
⟹ ws = ys ∧ x = y ∧ xs' = ys'›
note impw = ‹∀zs z zs'. w # ws = zs @ z # zs' ∧ obs_intra z S ≠ {} ⟶
(∃z''∈set (zs' @ [x]). ∃nx. call_of_return_node z'' nx ∧ nx ∉ S)›
note impy = ‹∀zs z zs'. ys = zs @ z # zs' ∧ obs_intra z S ≠ {} ⟶
(∃z''∈set (zs' @ [y]). ∃ny. call_of_return_node z'' ny ∧ ny ∉ S)›
show ?case
proof(cases ys)
case Nil
with ‹(w#ws) @ x # xs' = ys @ y # ys'› have "y = w" and "ys' = ws @ x # xs'"
by simp_all
from ‹y = w› ‹obs_intra y S ≠ {}› impw
have "∃z''∈set (ws @ [x]). ∃nx. call_of_return_node z'' nx ∧ nx ∉ S" by blast
with ‹ys' = ws @ x # xs'›
‹∀y'∈set ys'. ∃y''. call_of_return_node y' y'' ∧ y'' ∈ S›
have False by fastforce
thus ?thesis by simp
next
case (Cons w' ws')
with ‹(w # ws) @ x # xs' = ys @ y # ys'› have "w = w'"
and "ws @ x # xs' = ws' @ y # ys'" by simp_all
from impw have imp1:"∀zs z zs'. ws = zs @ z # zs' ∧ obs_intra z S ≠ {} ⟶
(∃z''∈set (zs' @ [x]). ∃nx. call_of_return_node z'' nx ∧ nx ∉ S)"
by clarsimp(erule_tac x="w#zs" in allE,clarsimp)
from Cons impy have imp2:"∀zs z zs'. ws' = zs @ z # zs' ∧ obs_intra z S ≠ {} ⟶
(∃z''∈set (zs' @ [y]). ∃ny. call_of_return_node z'' ny ∧ ny ∉ S)"
by clarsimp(erule_tac x="w'#zs" in allE,clarsimp)
from IH[OF ‹ws @ x # xs' = ws' @ y # ys'› ‹obs_intra x S ≠ {}›
‹∀x'∈set xs'. ∃x''. call_of_return_node x' x'' ∧ x'' ∈ S› imp1
‹obs_intra y S ≠ {}› ‹∀y'∈set ys'. ∃y''. call_of_return_node y' y'' ∧ y'' ∈ S›
imp2]
have "ws = ws' ∧ x = y ∧ xs' = ys'" .
with ‹w = w'› Cons show ?thesis by simp
qed
qed
lemma in_obs_valid:
assumes "ns' ∈ obs ns S" and "∀n ∈ set ns. valid_node n"
shows "∀n ∈ set ns'. valid_node n"
using ‹ns' ∈ obs ns S› ‹∀n ∈ set ns. valid_node n›
by(induct ns)(auto intro:in_obs_intra_valid simp:Let_def split:if_split_asm)
end
end
Theory Postdomination
section ‹Postdomination›
theory Postdomination imports CFGExit begin
text ‹For static interprocedural slicing, we only consider standard control
dependence, hence we only need standard postdomination.›
locale Postdomination = CFGExit sourcenode targetnode kind valid_edge Entry
get_proc get_return_edges procs Main Exit
for sourcenode :: "'edge ⇒ 'node" and targetnode :: "'edge ⇒ 'node"
and kind :: "'edge ⇒ ('var,'val,'ret,'pname) edge_kind"
and valid_edge :: "'edge ⇒ bool"
and Entry :: "'node" ("'('_Entry'_')") and get_proc :: "'node ⇒ 'pname"
and get_return_edges :: "'edge ⇒ 'edge set"
and procs :: "('pname × 'var list × 'var list) list" and Main :: "'pname"
and Exit::"'node" ("'('_Exit'_')") +
assumes Entry_path:"valid_node n ⟹ ∃as. (_Entry_) -as→⇩√* n"
and Exit_path:"valid_node n ⟹ ∃as. n -as→⇩√* (_Exit_)"
and method_exit_unique:
"⟦method_exit n; method_exit n'; get_proc n = get_proc n'⟧ ⟹ n = n'"
begin
lemma get_return_edges_unique:
assumes "valid_edge a" and "a' ∈ get_return_edges a" and "a'' ∈ get_return_edges a"
shows "a' = a''"
proof -
from ‹valid_edge a› ‹a' ∈ get_return_edges a›
obtain Q r p fs where "kind a = Q:r↪⇘p⇙fs"
by(fastforce dest!:only_call_get_return_edges)
with ‹valid_edge a› ‹a' ∈ get_return_edges a› obtain Q' f' where "kind a' = Q'↩⇘p⇙f'"
by(fastforce dest!:call_return_edges)
from ‹valid_edge a› ‹a' ∈ get_return_edges a› have "valid_edge a'"
by(rule get_return_edges_valid)
from this ‹kind a' = Q'↩⇘p⇙f'› have "get_proc (sourcenode a') = p"
by(rule get_proc_return)
from ‹valid_edge a'› ‹kind a' = Q'↩⇘p⇙f'› have "method_exit (sourcenode a')"
by(fastforce simp:method_exit_def)
from ‹valid_edge a› ‹a'' ∈ get_return_edges a› ‹kind a = Q:r↪⇘p⇙fs›
obtain Q'' f'' where "kind a'' = Q''↩⇘p⇙f''" by(fastforce dest!:call_return_edges)
from ‹valid_edge a› ‹a'' ∈ get_return_edges a› have "valid_edge a''"
by(rule get_return_edges_valid)
from this ‹kind a'' = Q''↩⇘p⇙f''› have "get_proc (sourcenode a'') = p"
by(rule get_proc_return)
from ‹valid_edge a''› ‹kind a'' = Q''↩⇘p⇙f''› have "method_exit (sourcenode a'')"
by(fastforce simp:method_exit_def)
with ‹method_exit (sourcenode a')› ‹get_proc (sourcenode a') = p›
‹get_proc (sourcenode a'') = p› have "sourcenode a' = sourcenode a''"
by(fastforce elim!:method_exit_unique)
from ‹valid_edge a› ‹a' ∈ get_return_edges a›
obtain ax' where "valid_edge ax'" and "sourcenode ax' = sourcenode a"
and "targetnode ax' = targetnode a'" and "intra_kind(kind ax')"
by -(drule call_return_node_edge,auto simp:intra_kind_def)
from ‹valid_edge a› ‹a'' ∈ get_return_edges a›
obtain ax'' where "valid_edge ax''" and "sourcenode ax'' = sourcenode a"
and "targetnode ax'' = targetnode a''" and "intra_kind(kind ax'')"
by -(drule call_return_node_edge,auto simp:intra_kind_def)
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹valid_edge ax'›
‹sourcenode ax' = sourcenode a› ‹intra_kind(kind ax')›
‹valid_edge ax''› ‹sourcenode ax'' = sourcenode a› ‹intra_kind(kind ax'')›
have "ax' = ax''" by -(drule call_only_one_intra_edge,auto)
with ‹targetnode ax' = targetnode a'› ‹targetnode ax'' = targetnode a''›
have "targetnode a' = targetnode a''" by simp
with ‹valid_edge a'› ‹valid_edge a''› ‹sourcenode a' = sourcenode a''›
show ?thesis by(rule edge_det)
qed
definition postdominate :: "'node ⇒ 'node ⇒ bool" ("_ postdominates _" [51,0])
where postdominate_def:"n' postdominates n ≡
(valid_node n ∧ valid_node n' ∧
(∀as pex. (n -as→⇩ι* pex ∧ method_exit pex) ⟶ n' ∈ set (sourcenodes as)))"
lemma postdominate_implies_inner_path:
assumes "n' postdominates n"
obtains as where "n -as→⇩ι* n'" and "n' ∉ set (sourcenodes as)"
proof(atomize_elim)
from ‹n' postdominates n› have "valid_node n"
and all:"∀as pex. (n -as→⇩ι* pex ∧ method_exit pex) ⟶ n' ∈ set (sourcenodes as)"
by(auto simp:postdominate_def)
from ‹valid_node n› obtain asx where "n -asx→⇩√* (_Exit_)" by(auto dest:Exit_path)
then obtain as where "n -as→⇩√* (_Exit_)"
and "∀a ∈ set as. intra_kind(kind a) ∨ (∃Q f p. kind a = Q↩⇘p⇙f)"
by -(erule valid_Exit_path_descending_path)
show "∃as. n -as→⇩ι* n' ∧ n' ∉ set (sourcenodes as)"
proof(cases "∃a ∈ set as. ∃Q f p. kind a = Q↩⇘p⇙f")
case True
then obtain asx ax asx' where [simp]:"as = asx@ax#asx'"
and "∃Q f p. kind ax = Q↩⇘p⇙f" and "∀a ∈ set asx. ∀Q f p. kind a ≠ Q↩⇘p⇙f"
by -(erule split_list_first_propE,simp)
with ‹∀a ∈ set as. intra_kind(kind a) ∨ (∃Q f p. kind a = Q↩⇘p⇙f)›
have "∀a ∈ set asx. intra_kind(kind a)" by auto
from ‹n -as→⇩√* (_Exit_)› have "n -asx→⇩√* sourcenode ax"
and "valid_edge ax" by(auto dest:vp_split)
from ‹n -asx→⇩√* sourcenode ax› ‹∀a ∈ set asx. intra_kind(kind a)›
have "n -asx→⇩ι* sourcenode ax" by(simp add:vp_def intra_path_def)
from ‹valid_edge ax› ‹∃Q f p. kind ax = Q↩⇘p⇙f›
have "method_exit (sourcenode ax)" by(fastforce simp:method_exit_def)
with ‹n -asx→⇩ι* sourcenode ax› all have "n' ∈ set (sourcenodes asx)" by fastforce
then obtain xs ys where "sourcenodes asx = xs@n'#ys" and "n' ∉ set xs"
by(fastforce dest:split_list_first)
then obtain as' a as'' where "xs = sourcenodes as'"
and [simp]:"asx = as'@a#as''" and "sourcenode a = n'"
by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
from ‹n -asx→⇩ι* sourcenode ax› have "n -as'→⇩ι* sourcenode a"
by(fastforce dest:path_split simp:intra_path_def)
with ‹sourcenode a = n'› ‹n' ∉ set xs› ‹xs = sourcenodes as'›
show ?thesis by fastforce
next
case False
with ‹∀a ∈ set as. intra_kind(kind a) ∨ (∃Q f p. kind a = Q↩⇘p⇙f)›
have "∀a ∈ set as. intra_kind(kind a)" by fastforce
with ‹n -as→⇩√* (_Exit_)› all have "n' ∈ set (sourcenodes as)"
by(auto simp:vp_def intra_path_def simp:method_exit_def)
then obtain xs ys where "sourcenodes as = xs@n'#ys" and "n' ∉ set xs"
by(fastforce dest:split_list_first)
then obtain as' a as'' where "xs = sourcenodes as'"
and [simp]:"as = as'@a#as''" and "sourcenode a = n'"
by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
from ‹n -as→⇩√* (_Exit_)› ‹∀a ∈ set as. intra_kind(kind a)› ‹as = as'@a#as''›
have "n -as'→⇩ι* sourcenode a"
by(fastforce dest:path_split simp:vp_def intra_path_def)
with ‹sourcenode a = n'› ‹n' ∉ set xs› ‹xs = sourcenodes as'›
show ?thesis by fastforce
qed
qed
lemma postdominate_variant:
assumes "n' postdominates n"
shows "∀as. n -as→⇩√* (_Exit_) ⟶ n' ∈ set (sourcenodes as)"
proof -
from ‹n' postdominates n›
have all:"∀as pex. (n -as→⇩ι* pex ∧ method_exit pex) ⟶ n' ∈ set (sourcenodes as)"
by(simp add:postdominate_def)
{ fix as assume "n -as→⇩√* (_Exit_)"
then obtain as' pex where "n -as'→⇩ι* pex" and "method_exit pex"
and "set(sourcenodes as') ⊆ set(sourcenodes as)"
by(erule valid_Exit_path_intra_path)
from ‹n -as'→⇩ι* pex› ‹method_exit pex› ‹n' postdominates n›
have "n' ∈ set (sourcenodes as')" by(fastforce simp:postdominate_def)
with ‹set(sourcenodes as') ⊆ set(sourcenodes as)›
have "n' ∈ set (sourcenodes as)" by fastforce }
thus ?thesis by simp
qed
lemma postdominate_refl:
assumes "valid_node n" and "¬ method_exit n" shows "n postdominates n"
using ‹valid_node n›
proof(induct rule:valid_node_cases)
case Entry
{ fix as pex assume "(_Entry_) -as→⇩ι* pex" and "method_exit pex"
from ‹method_exit pex› have "(_Entry_) ∈ set (sourcenodes as)"
proof(rule method_exit_cases)
assume "pex = (_Exit_)"
with ‹(_Entry_) -as→⇩ι* pex› have "as ≠ []"
apply(clarsimp simp:intra_path_def) apply(erule path.cases)
by (drule sym,simp,drule Exit_noteq_Entry,auto)
with ‹(_Entry_) -as→⇩ι* pex› have "hd (sourcenodes as) = (_Entry_)"
by(fastforce intro:path_sourcenode simp:intra_path_def)
with ‹as ≠ []›show ?thesis by(fastforce intro:hd_in_set simp:sourcenodes_def)
next
fix a Q p f assume "pex = sourcenode a" and "valid_edge a" and "kind a = Q↩⇘p⇙f"
from ‹(_Entry_) -as→⇩ι* pex› have "get_proc (_Entry_) = get_proc pex"
by(rule intra_path_get_procs)
hence "get_proc pex = Main" by(simp add:get_proc_Entry)
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f› have "get_proc (sourcenode a) = p"
by(rule get_proc_return)
with ‹pex = sourcenode a› ‹get_proc pex = Main› have "p = Main" by simp
with ‹valid_edge a› ‹kind a = Q↩⇘p⇙f› have False
by simp (rule Main_no_return_source)
thus ?thesis by simp
qed }
with Entry show ?thesis
by(fastforce intro:empty_path simp:postdominate_def intra_path_def)
next
case Exit
with ‹¬ method_exit n› have False by(simp add:method_exit_def)
thus ?thesis by simp
next
case inner
show ?thesis
proof(cases "∃as. n -as→⇩√* (_Exit_)")
case True
{ fix as pex assume "n -as→⇩ι* pex" and "method_exit pex"
with ‹¬ method_exit n› have "as ≠ []"
by(fastforce elim:path.cases simp:intra_path_def)
with ‹n -as→⇩ι* pex› inner have "hd (sourcenodes as) = n"
by(fastforce intro:path_sourcenode simp:intra_path_def)
from ‹as ≠ []› have "sourcenodes as ≠ []" by(simp add:sourcenodes_def)
with ‹hd (sourcenodes as) = n›[THEN sym]
have "n ∈ set (sourcenodes as)" by simp }
hence "∀as pex. (n -as→⇩ι* pex ∧ method_exit pex) ⟶ n ∈ set (sourcenodes as)"
by fastforce
with True inner show ?thesis
by(fastforce intro:empty_path
simp:postdominate_def inner_is_valid intra_path_def)
next
case False
with inner show ?thesis by(fastforce dest:inner_is_valid Exit_path)
qed
qed
lemma postdominate_trans:
assumes "n'' postdominates n" and "n' postdominates n''"
shows "n' postdominates n"
proof -
from ‹n'' postdominates n› ‹n' postdominates n''›
have "valid_node n" and "valid_node n'" by(simp_all add:postdominate_def)
{ fix as pex assume "n -as→⇩ι* pex" and "method_exit pex"
with ‹n'' postdominates n› have "n'' ∈ set (sourcenodes as)"
by(fastforce simp:postdominate_def)
then obtain ns' ns'' where "sourcenodes as = ns'@n''#ns''"
by(auto dest:split_list)
then obtain as' as'' a where "sourcenodes as'' = ns''" and [simp]:"as=as'@a#as''"
and [simp]:"sourcenode a = n''"
by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
from ‹n -as→⇩ι* pex› have "n -as'@a#as''→⇩ι* pex" by simp
hence "n'' -a#as''→⇩ι* pex"
by(fastforce dest:path_split_second simp:intra_path_def)
with ‹n' postdominates n''› ‹method_exit pex›
have "n' ∈ set(sourcenodes (a#as''))" by(fastforce simp:postdominate_def)
hence "n' ∈ set (sourcenodes as)" by(fastforce simp:sourcenodes_def) }
with ‹valid_node n› ‹valid_node n'›
show ?thesis by(fastforce simp:postdominate_def)
qed
lemma postdominate_antisym:
assumes "n' postdominates n" and "n postdominates n'"
shows "n = n'"
proof -
from ‹n' postdominates n› have "valid_node n" and "valid_node n'"
by(auto simp:postdominate_def)
from ‹valid_node n› obtain asx where "n -asx→⇩√* (_Exit_)" by(auto dest:Exit_path)
then obtain as' pex where "n -as'→⇩ι* pex" and "method_exit pex"
by -(erule valid_Exit_path_intra_path)
with ‹n' postdominates n› have "∃nx ∈ set(sourcenodes as'). nx = n'"
by(fastforce simp:postdominate_def)
then obtain ns ns' where "sourcenodes as' = ns@n'#ns'"
and "∀nx ∈ set ns'. nx ≠ n'"
by(fastforce elim!:split_list_last_propE)
from ‹sourcenodes as' = ns@n'#ns'› obtain asx a asx'
where [simp]:"ns' = sourcenodes asx'" "as' = asx@a#asx'" "sourcenode a = n'"
by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
from ‹n -as'→⇩ι* pex› have "n' -a#asx'→⇩ι* pex"
by(fastforce dest:path_split_second simp:intra_path_def)
with ‹n postdominates n'› ‹method_exit pex› have "n ∈ set(sourcenodes (a#asx'))"
by(fastforce simp:postdominate_def)
hence "n = n' ∨ n ∈ set(sourcenodes asx')" by(simp add:sourcenodes_def)
thus ?thesis
proof
assume "n = n'" thus ?thesis .
next
assume "n ∈ set(sourcenodes asx')"
then obtain nsx' nsx'' where "sourcenodes asx' = nsx'@n#nsx''"
by(auto dest:split_list)
then obtain asi asi' a' where [simp]:"asx' = asi@a'#asi'" "sourcenode a' = n"
by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
with ‹n -as'→⇩ι* pex› have "n -(asx@a#asi)@a'#asi'→⇩ι* pex" by simp
hence "n -(asx@a#asi)@a'#asi'→* pex"
and "∀a ∈ set ((asx@a#asi)@a'#asi'). intra_kind (kind a)"
by(simp_all add:intra_path_def)
from ‹n -(asx@a#asi)@a'#asi'→* pex›
have "n -a'#asi'→* pex" by(fastforce dest:path_split_second)
with ‹∀a ∈ set ((asx@a#asi)@a'#asi'). intra_kind (kind a)›
have "n -a'#asi'→⇩ι* pex" by(simp add:intra_path_def)
with ‹n' postdominates n› ‹method_exit pex›
have "n' ∈ set(sourcenodes (a'#asi'))" by(fastforce simp:postdominate_def)
hence "n' = n ∨ n' ∈ set(sourcenodes asi')"
by(simp add:sourcenodes_def)
thus ?thesis
proof
assume "n' = n" thus ?thesis by(rule sym)
next
assume "n' ∈ set(sourcenodes asi')"
with ‹∀nx ∈ set ns'. nx ≠ n'› have False by(fastforce simp:sourcenodes_def)
thus ?thesis by simp
qed
qed
qed
lemma postdominate_path_branch:
assumes "n -as→* n''" and "n' postdominates n''" and "¬ n' postdominates n"
obtains a as' as'' where "as = as'@a#as''" and "valid_edge a"
and "¬ n' postdominates (sourcenode a)" and "n' postdominates (targetnode a)"
proof(atomize_elim)
from assms
show "∃as' a as''. as = as'@a#as'' ∧ valid_edge a ∧
¬ n' postdominates (sourcenode a) ∧ n' postdominates (targetnode a)"
proof(induct rule:path.induct)
case (Cons_path n'' as nx a n)
note IH = ‹⟦n' postdominates nx; ¬ n' postdominates n''⟧
⟹ ∃as' a as''. as = as'@a#as'' ∧ valid_edge a ∧
¬ n' postdominates sourcenode a ∧ n' postdominates targetnode a›
show ?case
proof(cases "n' postdominates n''")
case True
with ‹¬ n' postdominates n› ‹sourcenode a = n› ‹targetnode a = n''›
‹valid_edge a› show ?thesis by blast
next
case False
from IH[OF ‹n' postdominates nx› this] show ?thesis
by clarsimp(rule_tac x="a#as'" in exI,clarsimp)
qed
qed simp
qed
lemma Exit_no_postdominator:
assumes "(_Exit_) postdominates n" shows False
proof -
from ‹(_Exit_) postdominates n› have "valid_node n" by(simp add:postdominate_def)
from ‹valid_node n› obtain asx where "n -asx→⇩√* (_Exit_)" by(auto dest:Exit_path)
then obtain as' pex where "n -as'→⇩ι* pex" and "method_exit pex"
by -(erule valid_Exit_path_intra_path)
with ‹(_Exit_) postdominates n› have "(_Exit_) ∈ set (sourcenodes as')"
by(fastforce simp:postdominate_def)
with ‹n -as'→⇩ι* pex› show False by(fastforce simp:intra_path_def)
qed
lemma postdominate_inner_path_targetnode:
assumes "n' postdominates n" and "n -as→⇩ι* n''" and "n' ∉ set(sourcenodes as)"
shows "n' postdominates n''"
proof -
from ‹n' postdominates n› obtain asx
where "valid_node n" and "valid_node n'"
and all:"∀as pex. (n -as→⇩ι* pex ∧ method_exit pex) ⟶ n' ∈ set (sourcenodes as)"
by(auto simp:postdominate_def)
from ‹n -as→⇩ι* n''› have "valid_node n''"
by(fastforce dest:path_valid_node simp:intra_path_def)
have "∀as' pex'. (n'' -as'→⇩ι* pex' ∧ method_exit pex') ⟶
n' ∈ set (sourcenodes as')"
proof(rule ccontr)
assume "¬ (∀as' pex'. (n'' -as'→⇩ι* pex' ∧ method_exit pex') ⟶
n' ∈ set (sourcenodes as'))"
then obtain as' pex' where "n'' -as'→⇩ι* pex'" and "method_exit pex'"
and "n' ∉ set (sourcenodes as')" by blast
from ‹n -as→⇩ι* n''› ‹n'' -as'→⇩ι* pex'› have "n -as@as'→⇩ι* pex'"
by(fastforce intro:path_Append simp:intra_path_def)
from ‹n' ∉ set(sourcenodes as)› ‹n' ∉ set (sourcenodes as')›
have "n' ∉ set (sourcenodes (as@as'))"
by(simp add:sourcenodes_def)
with ‹n -as@as'→⇩ι* pex'› ‹method_exit pex'› ‹n' postdominates n›
show False by(fastforce simp:postdominate_def)
qed
with ‹valid_node n'› ‹valid_node n''›
show ?thesis by(auto simp:postdominate_def)
qed
lemma not_postdominate_source_not_postdominate_target:
assumes "¬ n postdominates (sourcenode a)"
and "valid_node n" and "valid_edge a" and "intra_kind (kind a)"
obtains ax where "sourcenode a = sourcenode ax" and "valid_edge ax"
and "¬ n postdominates targetnode ax"
proof(atomize_elim)
show "∃ax. sourcenode a = sourcenode ax ∧ valid_edge ax ∧
¬ n postdominates targetnode ax"
proof -
from assms obtain asx pex
where "sourcenode a -asx→⇩ι* pex" and "method_exit pex"
and "n ∉ set(sourcenodes asx)" by(fastforce simp:postdominate_def)
show ?thesis
proof(cases asx)
case Nil
with ‹sourcenode a -asx→⇩ι* pex› have "pex = sourcenode a"
by(fastforce simp:intra_path_def)
with ‹method_exit pex› have "method_exit (sourcenode a)" by simp
thus ?thesis
proof(rule method_exit_cases)
assume "sourcenode a = (_Exit_)"
with ‹valid_edge a› have False by(rule Exit_source)
thus ?thesis by simp
next
fix a' Q f p assume "sourcenode a = sourcenode a'"
and "valid_edge a'" and "kind a' = Q↩⇘p⇙f"
hence False using ‹intra_kind (kind a)› ‹valid_edge a›
by(fastforce dest:return_edges_only simp:intra_kind_def)
thus ?thesis by simp
qed
next
case (Cons ax asx')
with ‹sourcenode a -asx→⇩ι* pex›
have "sourcenode a -[]@ax#asx'→* pex"
and "∀a ∈ set (ax#asx'). intra_kind (kind a)" by(simp_all add:intra_path_def)
from ‹sourcenode a -[]@ax#asx'→* pex›
have "sourcenode a = sourcenode ax" and "valid_edge ax"
and "targetnode ax -asx'→* pex" by(fastforce dest:path_split)+
with ‹∀a ∈ set (ax#asx'). intra_kind (kind a)›
have "targetnode ax -asx'→⇩ι* pex" by(simp add:intra_path_def)
with ‹n ∉ set(sourcenodes asx)› Cons ‹method_exit pex›
have "¬ n postdominates targetnode ax"
by(fastforce simp:postdominate_def sourcenodes_def)
with ‹sourcenode a = sourcenode ax› ‹valid_edge ax› show ?thesis by blast
qed
qed
qed
lemma inner_node_Exit_edge:
assumes "inner_node n"
obtains a where "valid_edge a" and "intra_kind (kind a)"
and "inner_node (sourcenode a)" and "targetnode a = (_Exit_)"
proof(atomize_elim)
from ‹inner_node n› have "valid_node n" by(rule inner_is_valid)
then obtain as where "n -as→⇩√* (_Exit_)" by(fastforce dest:Exit_path)
show "∃a. valid_edge a ∧ intra_kind (kind a) ∧ inner_node (sourcenode a) ∧
targetnode a = (_Exit_)"
proof(cases "as = []")
case True
with ‹inner_node n› ‹n -as→⇩√* (_Exit_)› have False by(fastforce simp:vp_def)
thus ?thesis by simp
next
case False
with ‹n -as→⇩√* (_Exit_)› obtain a' as' where "as = as'@[a']"
and "n -as'→⇩√* sourcenode a'" and "valid_edge a'"
and "(_Exit_) = targetnode a'" by -(erule vp_split_snoc)
from ‹valid_edge a'› have "valid_node (sourcenode a')" by simp
thus ?thesis
proof(cases "sourcenode a'" rule:valid_node_cases)
case Entry
with ‹n -as'→⇩√* sourcenode a'› have "n -as'→* (_Entry_)" by(simp add:vp_def)
with ‹inner_node n›
have False by -(drule path_Entry_target,auto simp:inner_node_def)
thus ?thesis by simp
next
case Exit
from ‹valid_edge a'› this have False by(rule Exit_source)
thus ?thesis by simp
next
case inner
have "intra_kind (kind a')"
proof(cases "kind a'" rule:edge_kind_cases)
case Intra thus ?thesis by simp
next
case (Call Q r p fs)
with ‹valid_edge a'› have "get_proc(targetnode a') = p" by(rule get_proc_call)
with ‹(_Exit_) = targetnode a'› get_proc_Exit have "p = Main" by simp
with ‹kind a' = Q:r↪⇘p⇙fs› have "kind a' = Q:r↪⇘Main⇙fs" by simp
with ‹valid_edge a'› have False by(rule Main_no_call_target)
thus ?thesis by simp
next
case (Return Q p f)
from ‹valid_edge a'› ‹kind a' = Q↩⇘p⇙f› ‹(_Exit_) = targetnode a'›[THEN sym]
have False by(rule Exit_no_return_target)
thus ?thesis by simp
qed
with ‹valid_edge a'› ‹(_Exit_) = targetnode a'› ‹inner_node (sourcenode a')›
show ?thesis by simp blast
qed
qed
qed
lemma inner_node_Entry_edge:
assumes "inner_node n"
obtains a where "valid_edge a" and "intra_kind (kind a)"
and "inner_node (targetnode a)" and "sourcenode a = (_Entry_)"
proof(atomize_elim)
from ‹inner_node n› have "valid_node n" by(rule inner_is_valid)
then obtain as where "(_Entry_) -as→⇩√* n" by(fastforce dest:Entry_path)
show "∃a. valid_edge a ∧ intra_kind (kind a) ∧ inner_node (targetnode a) ∧
sourcenode a = (_Entry_)"
proof(cases "as = []")
case True
with ‹inner_node n› ‹(_Entry_) -as→⇩√* n› have False
by(fastforce simp:inner_node_def vp_def)
thus ?thesis by simp
next
case False
with ‹(_Entry_) -as→⇩√* n› obtain a' as' where "as = a'#as'"
and "targetnode a' -as'→⇩√* n" and "valid_edge a'"
and "(_Entry_) = sourcenode a'" by -(erule vp_split_Cons)
from ‹valid_edge a'› have "valid_node (targetnode a')" by simp
thus ?thesis
proof(cases "targetnode a'" rule:valid_node_cases)
case Entry
from ‹valid_edge a'› this have False by(rule Entry_target)
thus ?thesis by simp
next
case Exit
with ‹targetnode a' -as'→⇩√* n› have "(_Exit_) -as'→* n" by(simp add:vp_def)
with ‹inner_node n›
have False by -(drule path_Exit_source,auto simp:inner_node_def)
thus ?thesis by simp
next
case inner
have "intra_kind (kind a')"
proof(cases "kind a'" rule:edge_kind_cases)
case Intra thus ?thesis by simp
next
case (Call Q r p fs)
from ‹valid_edge a'› ‹kind a' = Q:r↪⇘p⇙fs›
‹(_Entry_) = sourcenode a'›[THEN sym]
have False by(rule Entry_no_call_source)
thus ?thesis by simp
next
case (Return Q p f)
with ‹valid_edge a'› have "get_proc(sourcenode a') = p"
by(rule get_proc_return)
with ‹(_Entry_) = sourcenode a'› get_proc_Entry have "p = Main" by simp
with ‹kind a' = Q↩⇘p⇙f› have "kind a' = Q↩⇘Main⇙f" by simp
with ‹valid_edge a'› have False by(rule Main_no_return_source)
thus ?thesis by simp
qed
with ‹valid_edge a'› ‹(_Entry_) = sourcenode a'› ‹inner_node (targetnode a')›
show ?thesis by simp blast
qed
qed
qed
lemma intra_path_to_matching_method_exit:
assumes "method_exit n'" and "get_proc n = get_proc n'" and "valid_node n"
obtains as where "n -as→⇩ι* n'"
proof(atomize_elim)
from ‹valid_node n› obtain as' where "n -as'→⇩√* (_Exit_)"
by(fastforce dest:Exit_path)
then obtain as mex where "n -as→⇩ι* mex" and "method_exit mex"
by(fastforce elim:valid_Exit_path_intra_path)
from ‹n -as→⇩ι* mex› have "get_proc n = get_proc mex"
by(rule intra_path_get_procs)
with ‹method_exit n'› ‹get_proc n = get_proc n'› ‹method_exit mex›
have "mex = n'" by(fastforce intro:method_exit_unique)
with ‹n -as→⇩ι* mex› show "∃as. n -as→⇩ι* n'" by fastforce
qed
end
end
Theory SDG
section ‹SDG›
theory SDG imports CFGExit_wf Postdomination begin
subsection ‹The nodes of the SDG›
datatype 'node SDG_node =
CFG_node 'node
| Formal_in "'node × nat"
| Formal_out "'node × nat"
| Actual_in "'node × nat"
| Actual_out "'node × nat"
fun parent_node :: "'node SDG_node ⇒ 'node"
where "parent_node (CFG_node n) = n"
| "parent_node (Formal_in (m,x)) = m"
| "parent_node (Formal_out (m,x)) = m"
| "parent_node (Actual_in (m,x)) = m"
| "parent_node (Actual_out (m,x)) = m"
locale SDG = CFGExit_wf sourcenode targetnode kind valid_edge Entry
get_proc get_return_edges procs Main Exit Def Use ParamDefs ParamUses +
Postdomination sourcenode targetnode kind valid_edge Entry
get_proc get_return_edges procs Main Exit
for sourcenode :: "'edge ⇒ 'node" and targetnode :: "'edge ⇒ 'node"
and kind :: "'edge ⇒ ('var,'val,'ret,'pname) edge_kind"
and valid_edge :: "'edge ⇒ bool"
and Entry :: "'node" ("'('_Entry'_')") and get_proc :: "'node ⇒ 'pname"
and get_return_edges :: "'edge ⇒ 'edge set"
and procs :: "('pname × 'var list × 'var list) list" and Main :: "'pname"
and Exit::"'node" ("'('_Exit'_')")
and Def :: "'node ⇒ 'var set" and Use :: "'node ⇒ 'var set"
and ParamDefs :: "'node ⇒ 'var list" and ParamUses :: "'node ⇒ 'var set list"
begin
fun valid_SDG_node :: "'node SDG_node ⇒ bool"
where "valid_SDG_node (CFG_node n) ⟷ valid_node n"
| "valid_SDG_node (Formal_in (m,x)) ⟷
(∃a Q r p fs ins outs. valid_edge a ∧ (kind a = Q:r↪⇘p⇙fs) ∧ targetnode a = m ∧
(p,ins,outs) ∈ set procs ∧ x < length ins)"
| "valid_SDG_node (Formal_out (m,x)) ⟷
(∃a Q p f ins outs. valid_edge a ∧ (kind a = Q↩⇘p⇙f) ∧ sourcenode a = m ∧
(p,ins,outs) ∈ set procs ∧ x < length outs)"
| "valid_SDG_node (Actual_in (m,x)) ⟷
(∃a Q r p fs ins outs. valid_edge a ∧ (kind a = Q:r↪⇘p⇙fs) ∧ sourcenode a = m ∧
(p,ins,outs) ∈ set procs ∧ x < length ins)"
| "valid_SDG_node (Actual_out (m,x)) ⟷
(∃a Q p f ins outs. valid_edge a ∧ (kind a = Q↩⇘p⇙f) ∧ targetnode a = m ∧
(p,ins,outs) ∈ set procs ∧ x < length outs)"
lemma valid_SDG_CFG_node:
"valid_SDG_node n ⟹ valid_node (parent_node n)"
by(cases n) auto
lemma Formal_in_parent_det:
assumes "valid_SDG_node (Formal_in (m,x))" and "valid_SDG_node (Formal_in (m',x'))"
and "get_proc m = get_proc m'"
shows "m = m'"
proof -
from ‹valid_SDG_node (Formal_in (m,x))› obtain a Q r p fs ins outs
where "valid_edge a" and "kind a = Q:r↪⇘p⇙fs" and "targetnode a = m"
and "(p,ins,outs) ∈ set procs" and "x < length ins" by fastforce
from ‹valid_SDG_node (Formal_in (m',x'))› obtain a' Q' r' p' f' ins' outs'
where "valid_edge a'" and "kind a' = Q':r'↪⇘p'⇙f'" and "targetnode a' = m'"
and "(p',ins',outs') ∈ set procs" and "x' < length ins'" by fastforce
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹targetnode a = m›
have "get_proc m = p" by(fastforce intro:get_proc_call)
moreover
from ‹valid_edge a'› ‹kind a' = Q':r'↪⇘p'⇙f'› ‹targetnode a' = m'›
have "get_proc m' = p'" by(fastforce intro:get_proc_call)
ultimately have "p = p'" using ‹get_proc m = get_proc m'› by simp
with ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹valid_edge a'› ‹kind a' = Q':r'↪⇘p'⇙f'›
‹targetnode a = m› ‹targetnode a' = m'›
show ?thesis by(fastforce intro:same_proc_call_unique_target)
qed
lemma valid_SDG_node_parent_Entry:
assumes "valid_SDG_node n" and "parent_node n = (_Entry_)"
shows "n = CFG_node (_Entry_)"
proof(cases n)
case CFG_node with ‹parent_node n = (_Entry_)› show ?thesis by simp
next
case (Formal_in z)
with ‹parent_node n = (_Entry_)› obtain x
where [simp]:"z = ((_Entry_),x)" by(cases z) auto
with ‹valid_SDG_node n› Formal_in obtain a where "valid_edge a"
and "targetnode a = (_Entry_)" by auto
hence False by -(rule Entry_target,simp+)
thus ?thesis by simp
next
case (Formal_out z)
with ‹parent_node n = (_Entry_)› obtain x
where [simp]:"z = ((_Entry_),x)" by(cases z) auto
with ‹valid_SDG_node n› Formal_out obtain a Q p f where "valid_edge a"
and "kind a = Q↩⇘p⇙f" and "sourcenode a = (_Entry_)" by auto
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f› have "get_proc (sourcenode a) = p"
by(rule get_proc_return)
with ‹sourcenode a = (_Entry_)› have "p = Main"
by(auto simp:get_proc_Entry)
with ‹valid_edge a› ‹kind a = Q↩⇘p⇙f› have False
by(fastforce intro:Main_no_return_source)
thus ?thesis by simp
next
case (Actual_in z)
with ‹parent_node n = (_Entry_)› obtain x
where [simp]:"z = ((_Entry_),x)" by(cases z) auto
with ‹valid_SDG_node n› Actual_in obtain a Q r p fs where "valid_edge a"
and "kind a = Q:r↪⇘p⇙fs" and "sourcenode a = (_Entry_)" by fastforce
hence False by -(rule Entry_no_call_source,auto)
thus ?thesis by simp
next
case (Actual_out z)
with ‹parent_node n = (_Entry_)› obtain x
where [simp]:"z = ((_Entry_),x)" by(cases z) auto
with ‹valid_SDG_node n› Actual_out obtain a where "valid_edge a"
"targetnode a = (_Entry_)" by auto
hence False by -(rule Entry_target,simp+)
thus ?thesis by simp
qed
lemma valid_SDG_node_parent_Exit:
assumes "valid_SDG_node n" and "parent_node n = (_Exit_)"
shows "n = CFG_node (_Exit_)"
proof(cases n)
case CFG_node with ‹parent_node n = (_Exit_)› show ?thesis by simp
next
case (Formal_in z)
with ‹parent_node n = (_Exit_)› obtain x
where [simp]:"z = ((_Exit_),x)" by(cases z) auto
with ‹valid_SDG_node n› Formal_in obtain a Q r p fs where "valid_edge a"
and "kind a = Q:r↪⇘p⇙fs" and "targetnode a = (_Exit_)" by fastforce
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› have "get_proc (targetnode a) = p"
by(rule get_proc_call)
with ‹targetnode a = (_Exit_)› have "p = Main"
by(auto simp:get_proc_Exit)
with ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› have False
by(fastforce intro:Main_no_call_target)
thus ?thesis by simp
next
case (Formal_out z)
with ‹parent_node n = (_Exit_)› obtain x
where [simp]:"z = ((_Exit_),x)" by(cases z) auto
with ‹valid_SDG_node n› Formal_out obtain a where "valid_edge a"
and "sourcenode a = (_Exit_)" by auto
hence False by -(rule Exit_source,simp+)
thus ?thesis by simp
next
case (Actual_in z)
with ‹parent_node n = (_Exit_)› obtain x
where [simp]:"z = ((_Exit_),x)" by(cases z) auto
with ‹valid_SDG_node n› Actual_in obtain a where "valid_edge a"
and "sourcenode a = (_Exit_)" by auto
hence False by -(rule Exit_source,simp+)
thus ?thesis by simp
next
case (Actual_out z)
with ‹parent_node n = (_Exit_)› obtain x
where [simp]:"z = ((_Exit_),x)" by(cases z) auto
with ‹valid_SDG_node n› Actual_out obtain a Q p f where "valid_edge a"
and "kind a = Q↩⇘p⇙f" and "targetnode a = (_Exit_)" by auto
hence False by -(erule Exit_no_return_target,auto)
thus ?thesis by simp
qed
subsection ‹Data dependence›
inductive SDG_Use :: "'var ⇒ 'node SDG_node ⇒ bool" ("_ ∈ Use⇘SDG⇙ _")
where CFG_Use_SDG_Use:
"⟦valid_node m; V ∈ Use m; n = CFG_node m⟧ ⟹ V ∈ Use⇘SDG⇙ n"
| Actual_in_SDG_Use:
"⟦valid_SDG_node n; n = Actual_in (m,x); V ∈ (ParamUses m)!x⟧ ⟹ V ∈ Use⇘SDG⇙ n"
| Formal_out_SDG_Use:
"⟦valid_SDG_node n; n = Formal_out (m,x); get_proc m = p; (p,ins,outs) ∈ set procs;
V = outs!x⟧ ⟹ V ∈ Use⇘SDG⇙ n"
abbreviation notin_SDG_Use :: "'var ⇒ 'node SDG_node ⇒ bool" ("_ ∉ Use⇘SDG⇙ _")
where "V ∉ Use⇘SDG⇙ n ≡ ¬ V ∈ Use⇘SDG⇙ n"
lemma in_Use_valid_SDG_node:
"V ∈ Use⇘SDG⇙ n ⟹ valid_SDG_node n"
by(induct rule:SDG_Use.induct,auto intro:valid_SDG_CFG_node)
lemma SDG_Use_parent_Use:
"V ∈ Use⇘SDG⇙ n ⟹ V ∈ Use (parent_node n)"
proof(induct rule:SDG_Use.induct)
case CFG_Use_SDG_Use thus ?case by simp
next
case (Actual_in_SDG_Use n m x V)
from ‹valid_SDG_node n› ‹n = Actual_in (m, x)› obtain a Q r p fs ins outs
where "valid_edge a" and "kind a = Q:r↪⇘p⇙fs" and "sourcenode a = m"
and "(p,ins,outs) ∈ set procs" and "x < length ins" by fastforce
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹(p,ins,outs) ∈ set procs›
have "length(ParamUses (sourcenode a)) = length ins"
by(fastforce intro:ParamUses_call_source_length)
with ‹x < length ins›
have "(ParamUses (sourcenode a))!x ∈ set (ParamUses (sourcenode a))" by simp
with ‹V ∈ (ParamUses m)!x› ‹sourcenode a = m›
have "V ∈ Union (set (ParamUses m))" by fastforce
with ‹valid_edge a› ‹sourcenode a = m› ‹n = Actual_in (m, x)› show ?case
by(fastforce intro:ParamUses_in_Use)
next
case (Formal_out_SDG_Use n m x p ins outs V)
from ‹valid_SDG_node n› ‹n = Formal_out (m, x)› obtain a Q p' f ins' outs'
where "valid_edge a" and "kind a = Q↩⇘p'⇙f" and "sourcenode a = m"
and "(p',ins',outs') ∈ set procs" and "x < length outs'" by fastforce
from ‹valid_edge a› ‹kind a = Q↩⇘p'⇙f› have "get_proc (sourcenode a) = p'"
by(rule get_proc_return)
with ‹get_proc m = p› ‹sourcenode a = m› have [simp]:"p = p'" by simp
with ‹(p',ins',outs') ∈ set procs› ‹(p,ins,outs) ∈ set procs› unique_callers
have [simp]:"ins' = ins" "outs' = outs" by(auto dest:distinct_fst_isin_same_fst)
from ‹x < length outs'› ‹V = outs ! x› have "V ∈ set outs" by fastforce
with ‹valid_edge a› ‹kind a = Q↩⇘p'⇙f› ‹(p,ins,outs) ∈ set procs›
have "V ∈ Use (sourcenode a)" by(fastforce intro:outs_in_Use)
with ‹sourcenode a = m› ‹valid_SDG_node n› ‹n = Formal_out (m, x)›
show ?case by simp
qed
inductive SDG_Def :: "'var ⇒ 'node SDG_node ⇒ bool" ("_ ∈ Def⇘SDG⇙ _")
where CFG_Def_SDG_Def:
"⟦valid_node m; V ∈ Def m; n = CFG_node m⟧ ⟹ V ∈ Def⇘SDG⇙ n"
| Formal_in_SDG_Def:
"⟦valid_SDG_node n; n = Formal_in (m,x); get_proc m = p; (p,ins,outs) ∈ set procs;
V = ins!x⟧ ⟹ V ∈ Def⇘SDG⇙ n"
| Actual_out_SDG_Def:
"⟦valid_SDG_node n; n = Actual_out (m,x); V = (ParamDefs m)!x⟧ ⟹ V ∈ Def⇘SDG⇙ n"
abbreviation notin_SDG_Def :: "'var ⇒ 'node SDG_node ⇒ bool" ("_ ∉ Def⇘SDG⇙ _")
where "V ∉ Def⇘SDG⇙ n ≡ ¬ V ∈ Def⇘SDG⇙ n"
lemma in_Def_valid_SDG_node:
"V ∈ Def⇘SDG⇙ n ⟹ valid_SDG_node n"
by(induct rule:SDG_Def.induct,auto intro:valid_SDG_CFG_node)
lemma SDG_Def_parent_Def:
"V ∈ Def⇘SDG⇙ n ⟹ V ∈ Def (parent_node n)"
proof(induct rule:SDG_Def.induct)
case CFG_Def_SDG_Def thus ?case by simp
next
case (Formal_in_SDG_Def n m x p ins outs V)
from ‹valid_SDG_node n› ‹n = Formal_in (m, x)› obtain a Q r p' fs ins' outs'
where "valid_edge a" and "kind a = Q:r↪⇘p'⇙fs" and "targetnode a = m"
and "(p',ins',outs') ∈ set procs" and "x < length ins'" by fastforce
from ‹valid_edge a› ‹kind a = Q:r↪⇘p'⇙fs› have "get_proc (targetnode a) = p'"
by(rule get_proc_call)
with ‹get_proc m = p› ‹targetnode a = m› have [simp]:"p = p'" by simp
with ‹(p',ins',outs') ∈ set procs› ‹(p,ins,outs) ∈ set procs› unique_callers
have [simp]:"ins' = ins" "outs' = outs" by(auto dest:distinct_fst_isin_same_fst)
from ‹x < length ins'› ‹V = ins ! x› have "V ∈ set ins" by fastforce
with ‹valid_edge a› ‹kind a = Q:r↪⇘p'⇙fs› ‹(p,ins,outs) ∈ set procs›
have "V ∈ Def (targetnode a)" by(fastforce intro:ins_in_Def)
with ‹targetnode a = m› ‹valid_SDG_node n› ‹n = Formal_in (m, x)›
show ?case by simp
next
case (Actual_out_SDG_Def n m x V)
from ‹valid_SDG_node n› ‹n = Actual_out (m, x)› obtain a Q p f ins outs
where "valid_edge a" and "kind a = Q↩⇘p⇙f" and "targetnode a = m"
and "(p,ins,outs) ∈ set procs" and "x < length outs" by fastforce
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f› ‹(p,ins,outs) ∈ set procs›
have "length(ParamDefs (targetnode a)) = length outs"
by(rule ParamDefs_return_target_length)
with ‹x < length outs› ‹V = ParamDefs m ! x› ‹targetnode a = m›
have "V ∈ set (ParamDefs (targetnode a))" by(fastforce simp:set_conv_nth)
with ‹n = Actual_out (m, x)› ‹targetnode a = m› ‹valid_edge a›
show ?case by(fastforce intro:ParamDefs_in_Def)
qed
definition data_dependence :: "'node SDG_node ⇒ 'var ⇒ 'node SDG_node ⇒ bool"
("_ influences _ in _" [51,0,0])
where "n influences V in n' ≡ ∃as. (V ∈ Def⇘SDG⇙ n) ∧ (V ∈ Use⇘SDG⇙ n') ∧
(parent_node n -as→⇩ι* parent_node n') ∧
(∀n''. valid_SDG_node n'' ∧ parent_node n'' ∈ set (sourcenodes (tl as))
⟶ V ∉ Def⇘SDG⇙ n'')"
subsection ‹Control dependence›
definition control_dependence :: "'node ⇒ 'node ⇒ bool"
("_ controls _" [51,0])
where "n controls n' ≡ ∃a a' as. n -a#as→⇩ι* n' ∧ n' ∉ set(sourcenodes (a#as)) ∧
intra_kind(kind a) ∧ n' postdominates (targetnode a) ∧
valid_edge a' ∧ intra_kind(kind a') ∧ sourcenode a' = n ∧
¬ n' postdominates (targetnode a')"
lemma control_dependence_path:
assumes "n controls n'" obtains as where "n -as→⇩ι* n'" and "as ≠ []"
using ‹n controls n'›
by(fastforce simp:control_dependence_def)
lemma Exit_does_not_control [dest]:
assumes "(_Exit_) controls n'" shows "False"
proof -
from ‹(_Exit_) controls n'› obtain a where "valid_edge a"
and "sourcenode a = (_Exit_)" by(auto simp:control_dependence_def)
thus ?thesis by(rule Exit_source)
qed
lemma Exit_not_control_dependent:
assumes "n controls n'" shows "n' ≠ (_Exit_)"
proof -
from ‹n controls n'› obtain a as where "n -a#as→⇩ι* n'"
and "n' postdominates (targetnode a)"
by(auto simp:control_dependence_def)
from ‹n -a#as→⇩ι* n'› have "valid_edge a"
by(fastforce elim:path.cases simp:intra_path_def)
hence "valid_node (targetnode a)" by simp
with ‹n' postdominates (targetnode a)› ‹n -a#as→⇩ι* n'› show ?thesis
by(fastforce elim:Exit_no_postdominator)
qed
lemma which_node_intra_standard_control_dependence_source:
assumes "nx -as@a#as'→⇩ι* n" and "sourcenode a = n'" and "sourcenode a' = n'"
and "n ∉ set(sourcenodes (a#as'))" and "valid_edge a'" and "intra_kind(kind a')"
and "inner_node n" and "¬ method_exit n" and "¬ n postdominates (targetnode a')"
and last:"∀ax ax'. ax ∈ set as' ∧ sourcenode ax = sourcenode ax' ∧
valid_edge ax' ∧ intra_kind(kind ax') ⟶ n postdominates targetnode ax'"
shows "n' controls n"
proof -
from ‹nx -as@a#as'→⇩ι* n› ‹sourcenode a = n'› have "n' -a#as'→⇩ι* n"
by(fastforce dest:path_split_second simp:intra_path_def)
from ‹nx -as@a#as'→⇩ι* n› have "valid_edge a"
by(fastforce intro:path_split simp:intra_path_def)
show ?thesis
proof(cases "n postdominates (targetnode a)")
case True
with ‹n' -a#as'→⇩ι* n› ‹n ∉ set(sourcenodes (a#as'))›
‹valid_edge a'› ‹intra_kind(kind a')› ‹sourcenode a' = n'›
‹¬ n postdominates (targetnode a')› show ?thesis
by(fastforce simp:control_dependence_def intra_path_def)
next
case False
show ?thesis
proof(cases "as' = []")
case True
with ‹n' -a#as'→⇩ι* n› have "targetnode a = n"
by(fastforce elim:path.cases simp:intra_path_def)
with ‹inner_node n› ‹¬ method_exit n› have "n postdominates (targetnode a)"
by(fastforce dest:inner_is_valid intro:postdominate_refl)
with ‹¬ n postdominates (targetnode a)› show ?thesis by simp
next
case False
with ‹nx -as@a#as'→⇩ι* n› have "targetnode a -as'→⇩ι* n"
by(fastforce intro:path_split simp:intra_path_def)
with ‹¬ n postdominates (targetnode a)› ‹valid_edge a› ‹inner_node n›
‹targetnode a -as'→⇩ι* n›
obtain asx pex where "targetnode a -asx→⇩ι* pex" and "method_exit pex"
and "n ∉ set (sourcenodes asx)"
by(fastforce dest:inner_is_valid simp:postdominate_def)
show ?thesis
proof(cases "∃asx'. asx = as'@asx'")
case True
then obtain asx' where [simp]:"asx = as'@asx'" by blast
from ‹targetnode a -asx→⇩ι* pex› ‹targetnode a -as'→⇩ι* n›
‹as' ≠ []› ‹method_exit pex› ‹¬ method_exit n›
obtain a'' as'' where "asx' = a''#as'' ∧ sourcenode a'' = n"
by(cases asx')(auto dest:path_split path_det simp:intra_path_def)
hence "n ∈ set(sourcenodes asx)" by(simp add:sourcenodes_def)
with ‹n ∉ set (sourcenodes asx)› have False by simp
thus ?thesis by simp
next
case False
hence "∀asx'. asx ≠ as'@asx'" by simp
then obtain j asx' where "asx = (take j as')@asx'"
and "j < length as'" and "∀k > j. ∀asx''. asx ≠ (take k as')@asx''"
by(auto elim:path_split_general)
from ‹asx = (take j as')@asx'› ‹j < length as'›
have "∃as'1 as'2. asx = as'1@asx' ∧
as' = as'1@as'2 ∧ as'2 ≠ [] ∧ as'1 = take j as'"
by simp(rule_tac x= "drop j as'" in exI,simp)
then obtain as'1 as'' where "asx = as'1@asx'"
and "as'1 = take j as'"
and "as' = as'1@as''" and "as'' ≠ []" by blast
from ‹as' = as'1@as''› ‹as'' ≠ []› obtain a1 as'2
where "as' = as'1@a1#as'2" and "as'' = a1#as'2"
by(cases as'') auto
have "asx' ≠ []"
proof(cases "asx' = []")
case True
with ‹asx = as'1@asx'› ‹as' = as'1@as''› ‹as'' = a1#as'2›
have "as' = asx@a1#as'2" by simp
with ‹n' -a#as'→⇩ι* n› have "n' -(a#asx)@a1#as'2→⇩ι* n" by simp
hence "n' -(a#asx)@a1#as'2→* n"
and "∀ax ∈ set((a#asx)@a1#as'2). intra_kind(kind ax)"
by(simp_all add:intra_path_def)
from ‹n' -(a#asx)@a1#as'2→* n›
have "n' -a#asx→* sourcenode a1" and "valid_edge a1"
by -(erule path_split)+
from ‹∀ax ∈ set((a#asx)@a1#as'2). intra_kind(kind ax)›
have "∀ax ∈ set(a#asx). intra_kind(kind ax)" by simp
with ‹n' -a#asx→* sourcenode a1› have "n' -a#asx→⇩ι* sourcenode a1"
by(simp add:intra_path_def)
hence "targetnode a -asx→⇩ι* sourcenode a1"
by(fastforce intro:path_split_Cons simp:intra_path_def)
with ‹targetnode a -asx→⇩ι* pex› have "pex = sourcenode a1"
by(fastforce intro:path_det simp:intra_path_def)
from ‹∀ax ∈ set((a#asx)@a1#as'2). intra_kind(kind ax)›
have "intra_kind (kind a1)" by simp
from ‹method_exit pex› have False
proof(rule method_exit_cases)
assume "pex = (_Exit_)"
with ‹pex = sourcenode a1› have "sourcenode a1 = (_Exit_)" by simp
with ‹valid_edge a1› show False by(rule Exit_source)
next
fix a Q f p assume "pex = sourcenode a" and "valid_edge a"
and "kind a = Q↩⇘p⇙f"
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f› ‹pex = sourcenode a›
‹pex = sourcenode a1› ‹valid_edge a1› ‹intra_kind (kind a1)›
show False by(fastforce dest:return_edges_only simp:intra_kind_def)
qed
thus ?thesis by simp
qed simp
with ‹asx = as'1@asx'› obtain a2 asx'1
where "asx = as'1@a2#asx'1"
and "asx' = a2#asx'1" by(cases asx') auto
from ‹n' -a#as'→⇩ι* n› ‹as' = as'1@a1#as'2›
have "n' -(a#as'1)@a1#as'2→⇩ι* n" by simp
hence "n' -(a#as'1)@a1#as'2→* n"
and "∀ax ∈ set((a#as'1)@a1#as'2). intra_kind(kind ax)"
by(simp_all add: intra_path_def)
from ‹n' -(a#as'1)@a1#as'2→* n› have "n' -a#as'1→* sourcenode a1"
and "valid_edge a1" by -(erule path_split)+
from ‹∀ax ∈ set((a#as'1)@a1#as'2). intra_kind(kind ax)›
have "∀ax ∈ set(a#as'1). intra_kind(kind ax)" by simp
with ‹n' -a#as'1→* sourcenode a1› have "n' -a#as'1→⇩ι* sourcenode a1"
by(simp add:intra_path_def)
hence "targetnode a -as'1→⇩ι* sourcenode a1"
by(fastforce intro:path_split_Cons simp:intra_path_def)
from ‹targetnode a -asx→⇩ι* pex› ‹asx = as'1@a2#asx'1›
have "targetnode a -as'1@a2#asx'1→* pex" by(simp add:intra_path_def)
hence "targetnode a -as'1→* sourcenode a2" and "valid_edge a2"
and "targetnode a2 -asx'1→* pex" by(auto intro:path_split)
from ‹targetnode a2 -asx'1→* pex› ‹asx = as'1@a2#asx'1›
‹targetnode a -asx→⇩ι* pex›
have "targetnode a2 -asx'1→⇩ι* pex" by(simp add:intra_path_def)
from ‹targetnode a -as'1→* sourcenode a2›
‹targetnode a -as'1→⇩ι* sourcenode a1›
have "sourcenode a1 = sourcenode a2"
by(fastforce intro:path_det simp:intra_path_def)
from ‹asx = as'1@a2#asx'1› ‹n ∉ set (sourcenodes asx)›
have "n ∉ set (sourcenodes asx'1)" by(simp add:sourcenodes_def)
with ‹targetnode a2 -asx'1→⇩ι* pex› ‹method_exit pex›
‹asx = as'1@a2#asx'1›
have "¬ n postdominates targetnode a2" by(fastforce simp:postdominate_def)
from ‹asx = as'1@a2#asx'1› ‹targetnode a -asx→⇩ι* pex›
have "intra_kind (kind a2)" by(simp add:intra_path_def)
from ‹as' = as'1@a1#as'2› have "a1 ∈ set as'" by simp
with ‹sourcenode a1 = sourcenode a2› last ‹valid_edge a2›
‹intra_kind (kind a2)›
have "n postdominates targetnode a2" by blast
with ‹¬ n postdominates targetnode a2› have False by simp
thus ?thesis by simp
qed
qed
qed
qed
subsection ‹SDG without summary edges›
inductive cdep_edge :: "'node SDG_node ⇒ 'node SDG_node ⇒ bool"
("_ ⟶⇘cd⇙ _" [51,0] 80)
and ddep_edge :: "'node SDG_node ⇒ 'var ⇒ 'node SDG_node ⇒ bool"
("_ -_→⇩d⇩d _" [51,0,0] 80)
and call_edge :: "'node SDG_node ⇒ 'pname ⇒ 'node SDG_node ⇒ bool"
("_ -_→⇘call⇙ _" [51,0,0] 80)
and return_edge :: "'node SDG_node ⇒ 'pname ⇒ 'node SDG_node ⇒ bool"
("_ -_→⇘ret⇙ _" [51,0,0] 80)
and param_in_edge :: "'node SDG_node ⇒ 'pname ⇒ 'var ⇒ 'node SDG_node ⇒ bool"
("_ -_:_→⇘in⇙ _" [51,0,0,0] 80)
and param_out_edge :: "'node SDG_node ⇒ 'pname ⇒ 'var ⇒ 'node SDG_node ⇒ bool"
("_ -_:_→⇘out⇙ _" [51,0,0,0] 80)
and SDG_edge :: "'node SDG_node ⇒ 'var option ⇒
('pname × bool) option ⇒ 'node SDG_node ⇒ bool"
where
"n ⟶⇘cd⇙ n' == SDG_edge n None None n'"
| "n -V→⇩d⇩d n' == SDG_edge n (Some V) None n'"
| "n -p→⇘call⇙ n' == SDG_edge n None (Some(p,True)) n'"
| "n -p→⇘ret⇙ n' == SDG_edge n None (Some(p,False)) n'"
| "n -p:V→⇘in⇙ n' == SDG_edge n (Some V) (Some(p,True)) n'"
| "n -p:V→⇘out⇙ n' == SDG_edge n (Some V) (Some(p,False)) n'"
| SDG_cdep_edge:
"⟦n = CFG_node m; n' = CFG_node m'; m controls m'⟧ ⟹ n ⟶⇘cd⇙ n'"
| SDG_proc_entry_exit_cdep:
"⟦valid_edge a; kind a = Q:r↪⇘p⇙fs; n = CFG_node (targetnode a);
a' ∈ get_return_edges a; n' = CFG_node (sourcenode a')⟧ ⟹ n ⟶⇘cd⇙ n'"
| SDG_parent_cdep_edge:
"⟦valid_SDG_node n'; m = parent_node n'; n = CFG_node m; n ≠ n'⟧
⟹ n ⟶⇘cd⇙ n'"
| SDG_ddep_edge:"n influences V in n' ⟹ n -V→⇩d⇩d n'"
| SDG_call_edge:
"⟦valid_edge a; kind a = Q:r↪⇘p⇙fs; n = CFG_node (sourcenode a);
n' = CFG_node (targetnode a)⟧ ⟹ n -p→⇘call⇙ n'"
| SDG_return_edge:
"⟦valid_edge a; kind a = Q↩⇘p⇙f; n = CFG_node (sourcenode a);
n' = CFG_node (targetnode a)⟧ ⟹ n -p→⇘ret⇙ n'"
| SDG_param_in_edge:
"⟦valid_edge a; kind a = Q:r↪⇘p⇙fs; (p,ins,outs) ∈ set procs; V = ins!x;
x < length ins; n = Actual_in (sourcenode a,x); n' = Formal_in (targetnode a,x)⟧
⟹ n -p:V→⇘in⇙ n'"
| SDG_param_out_edge:
"⟦valid_edge a; kind a = Q↩⇘p⇙f; (p,ins,outs) ∈ set procs; V = outs!x;
x < length outs; n = Formal_out (sourcenode a,x);
n' = Actual_out (targetnode a,x)⟧
⟹ n -p:V→⇘out⇙ n'"
lemma cdep_edge_cases:
"⟦n ⟶⇘cd⇙ n'; (parent_node n) controls (parent_node n') ⟹ P;
⋀a Q r p fs a'. ⟦valid_edge a; kind a = Q:r↪⇘p⇙fs; a' ∈ get_return_edges a;
parent_node n = targetnode a; parent_node n' = sourcenode a'⟧ ⟹ P;
⋀m. ⟦n = CFG_node m; m = parent_node n'; n ≠ n'⟧ ⟹ P⟧ ⟹ P"
by -(erule SDG_edge.cases,auto)
lemma SDG_edge_valid_SDG_node:
assumes "SDG_edge n Vopt popt n'"
shows "valid_SDG_node n" and "valid_SDG_node n'"
using ‹SDG_edge n Vopt popt n'›
proof(induct rule:SDG_edge.induct)
case (SDG_cdep_edge n m n' m')
thus "valid_SDG_node n" "valid_SDG_node n'"
by(fastforce elim:control_dependence_path elim:path_valid_node
simp:intra_path_def)+
next
case (SDG_proc_entry_exit_cdep a Q r p f n a' n') case 1
from ‹valid_edge a› ‹n = CFG_node (targetnode a)› show ?case by simp
next
case (SDG_proc_entry_exit_cdep a Q r p f n a' n') case 2
from ‹valid_edge a› ‹a' ∈ get_return_edges a› have "valid_edge a'"
by(rule get_return_edges_valid)
with ‹n' = CFG_node (sourcenode a')› show ?case by simp
next
case (SDG_ddep_edge n V n')
thus "valid_SDG_node n" "valid_SDG_node n'"
by(auto intro:in_Use_valid_SDG_node in_Def_valid_SDG_node
simp:data_dependence_def)
qed(fastforce intro:valid_SDG_CFG_node)+
lemma valid_SDG_node_cases:
assumes "valid_SDG_node n"
shows "n = CFG_node (parent_node n) ∨ CFG_node (parent_node n) ⟶⇘cd⇙ n"
proof(cases n)
case (CFG_node m) thus ?thesis by simp
next
case (Formal_in z)
from ‹n = Formal_in z› obtain m x where "z = (m,x)" by(cases z) auto
with ‹valid_SDG_node n› ‹n = Formal_in z› have "CFG_node (parent_node n) ⟶⇘cd⇙ n"
by -(rule SDG_parent_cdep_edge,auto)
thus ?thesis by fastforce
next
case (Formal_out z)
from ‹n = Formal_out z› obtain m x where "z = (m,x)" by(cases z) auto
with ‹valid_SDG_node n› ‹n = Formal_out z› have "CFG_node (parent_node n) ⟶⇘cd⇙ n"
by -(rule SDG_parent_cdep_edge,auto)
thus ?thesis by fastforce
next
case (Actual_in z)
from ‹n = Actual_in z› obtain m x where "z = (m,x)" by(cases z) auto
with ‹valid_SDG_node n› ‹n = Actual_in z› have "CFG_node (parent_node n) ⟶⇘cd⇙ n"
by -(rule SDG_parent_cdep_edge,auto)
thus ?thesis by fastforce
next
case (Actual_out z)
from ‹n = Actual_out z› obtain m x where "z = (m,x)" by(cases z) auto
with ‹valid_SDG_node n› ‹n = Actual_out z› have "CFG_node (parent_node n) ⟶⇘cd⇙ n"
by -(rule SDG_parent_cdep_edge,auto)
thus ?thesis by fastforce
qed
lemma SDG_cdep_edge_CFG_node: "n ⟶⇘cd⇙ n' ⟹ ∃m. n = CFG_node m"
by(induct n Vopt≡"None::'var option" popt≡"None::('pname × bool) option" n'
rule:SDG_edge.induct) auto
lemma SDG_call_edge_CFG_node: "n -p→⇘call⇙ n' ⟹ ∃m. n = CFG_node m"
by(induct n Vopt≡"None::'var option" popt≡"Some(p,True)" n'
rule:SDG_edge.induct) auto
lemma SDG_return_edge_CFG_node: "n -p→⇘ret⇙ n' ⟹ ∃m. n = CFG_node m"
by(induct n Vopt≡"None::'var option" popt≡"Some(p,False)" n'
rule:SDG_edge.induct) auto
lemma SDG_call_or_param_in_edge_unique_CFG_call_edge:
"SDG_edge n Vopt (Some(p,True)) n'
⟹ ∃!a. valid_edge a ∧ sourcenode a = parent_node n ∧
targetnode a = parent_node n' ∧ (∃Q r fs. kind a = Q:r↪⇘p⇙fs)"
proof(induct n Vopt "Some(p,True)" n' rule:SDG_edge.induct)
case (SDG_call_edge a Q r fs n n')
{ fix a'
assume "valid_edge a'" and "sourcenode a' = parent_node n"
and "targetnode a' = parent_node n'"
from ‹sourcenode a' = parent_node n› ‹n = CFG_node (sourcenode a)›
have "sourcenode a' = sourcenode a" by fastforce
moreover from ‹targetnode a' = parent_node n'› ‹n' = CFG_node (targetnode a)›
have "targetnode a' = targetnode a" by fastforce
ultimately have "a' = a" using ‹valid_edge a'› ‹valid_edge a›
by(fastforce intro:edge_det) }
with ‹valid_edge a› ‹n = CFG_node (sourcenode a)› ‹n' = CFG_node (targetnode a)›
‹kind a = Q:r↪⇘p⇙fs› show ?case by(fastforce intro!:ex1I[of _ a])
next
case (SDG_param_in_edge a Q r fs ins outs V x n n')
{ fix a'
assume "valid_edge a'" and "sourcenode a' = parent_node n"
and "targetnode a' = parent_node n'"
from ‹sourcenode a' = parent_node n› ‹n = Actual_in (sourcenode a,x)›
have "sourcenode a' = sourcenode a" by fastforce
moreover from ‹targetnode a' = parent_node n'› ‹n' = Formal_in (targetnode a,x)›
have "targetnode a' = targetnode a" by fastforce
ultimately have "a' = a" using ‹valid_edge a'› ‹valid_edge a›
by(fastforce intro:edge_det) }
with ‹valid_edge a› ‹n = Actual_in (sourcenode a,x)›
‹n' = Formal_in (targetnode a,x)› ‹kind a = Q:r↪⇘p⇙fs›
show ?case by(fastforce intro!:ex1I[of _ a])
qed simp_all
lemma SDG_return_or_param_out_edge_unique_CFG_return_edge:
"SDG_edge n Vopt (Some(p,False)) n'
⟹ ∃!a. valid_edge a ∧ sourcenode a = parent_node n ∧
targetnode a = parent_node n' ∧ (∃Q f. kind a = Q↩⇘p⇙f)"
proof(induct n Vopt "Some(p,False)" n' rule:SDG_edge.induct)
case (SDG_return_edge a Q f n n')
{ fix a'
assume "valid_edge a'" and "sourcenode a' = parent_node n"
and "targetnode a' = parent_node n'"
from ‹sourcenode a' = parent_node n› ‹n = CFG_node (sourcenode a)›
have "sourcenode a' = sourcenode a" by fastforce
moreover from ‹targetnode a' = parent_node n'› ‹n' = CFG_node (targetnode a)›
have "targetnode a' = targetnode a" by fastforce
ultimately have "a' = a" using ‹valid_edge a'› ‹valid_edge a›
by(fastforce intro:edge_det) }
with ‹valid_edge a› ‹n = CFG_node (sourcenode a)› ‹n' = CFG_node (targetnode a)›
‹kind a = Q↩⇘p⇙f› show ?case by(fastforce intro!:ex1I[of _ a])
next
case (SDG_param_out_edge a Q f ins outs V x n n')
{ fix a'
assume "valid_edge a'" and "sourcenode a' = parent_node n"
and "targetnode a' = parent_node n'"
from ‹sourcenode a' = parent_node n› ‹n = Formal_out (sourcenode a,x)›
have "sourcenode a' = sourcenode a" by fastforce
moreover from ‹targetnode a' = parent_node n'› ‹n' = Actual_out (targetnode a,x)›
have "targetnode a' = targetnode a" by fastforce
ultimately have "a' = a" using ‹valid_edge a'› ‹valid_edge a›
by(fastforce intro:edge_det) }
with ‹valid_edge a› ‹n = Formal_out (sourcenode a,x)›
‹n' = Actual_out (targetnode a,x)› ‹kind a = Q↩⇘p⇙f›
show ?case by(fastforce intro!:ex1I[of _ a])
qed simp_all
lemma Exit_no_SDG_edge_source:
"SDG_edge (CFG_node (_Exit_)) Vopt popt n' ⟹ False"
proof(induct "CFG_node (_Exit_)" Vopt popt n' rule:SDG_edge.induct)
case (SDG_cdep_edge m n' m')
hence "(_Exit_) controls m'" by simp
thus ?case by fastforce
next
case (SDG_proc_entry_exit_cdep a Q r p fs a' n')
from ‹CFG_node (_Exit_) = CFG_node (targetnode a)›
have "targetnode a = (_Exit_)" by simp
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› have "get_proc (targetnode a) = p"
by(rule get_proc_call)
with ‹targetnode a = (_Exit_)› have "p = Main"
by(auto simp:get_proc_Exit)
with ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› have False
by(fastforce intro:Main_no_call_target)
thus ?thesis by simp
next
case (SDG_parent_cdep_edge n' m)
from ‹CFG_node (_Exit_) = CFG_node m›
have [simp]:"m = (_Exit_)" by simp
with ‹valid_SDG_node n'› ‹m = parent_node n'› ‹CFG_node (_Exit_) ≠ n'›
have False by -(drule valid_SDG_node_parent_Exit,simp+)
thus ?thesis by simp
next
case (SDG_ddep_edge V n')
hence "(CFG_node (_Exit_)) influences V in n'" by simp
with Exit_empty show ?case
by(fastforce dest:path_Exit_source SDG_Def_parent_Def
simp:data_dependence_def intra_path_def)
next
case (SDG_call_edge a Q r p fs n')
from ‹CFG_node (_Exit_) = CFG_node (sourcenode a)›
have "sourcenode a = (_Exit_)" by simp
with ‹valid_edge a› show ?case by(rule Exit_source)
next
case (SDG_return_edge a Q p f n')
from ‹CFG_node (_Exit_) = CFG_node (sourcenode a)›
have "sourcenode a = (_Exit_)" by simp
with ‹valid_edge a› show ?case by(rule Exit_source)
qed simp_all
subsection ‹Intraprocedural paths in the SDG›
inductive intra_SDG_path ::
"'node SDG_node ⇒ 'node SDG_node list ⇒ 'node SDG_node ⇒ bool"
("_ i-_→⇩d* _" [51,0,0] 80)
where iSp_Nil:
"valid_SDG_node n ⟹ n i-[]→⇩d* n"
| iSp_Append_cdep:
"⟦n i-ns→⇩d* n''; n'' ⟶⇘cd⇙ n'⟧ ⟹ n i-ns@[n'']→⇩d* n'"
| iSp_Append_ddep:
"⟦n i-ns→⇩d* n''; n'' -V→⇩d⇩d n'; n'' ≠ n'⟧ ⟹ n i-ns@[n'']→⇩d* n'"
lemma intra_SDG_path_Append:
"⟦n'' i-ns'→⇩d* n'; n i-ns→⇩d* n''⟧ ⟹ n i-ns@ns'→⇩d* n'"
by(induct rule:intra_SDG_path.induct,
auto intro:intra_SDG_path.intros simp:append_assoc[THEN sym] simp del:append_assoc)
lemma intra_SDG_path_valid_SDG_node:
assumes "n i-ns→⇩d* n'" shows "valid_SDG_node n" and "valid_SDG_node n'"
using ‹n i-ns→⇩d* n'›
by(induct rule:intra_SDG_path.induct,
auto intro:SDG_edge_valid_SDG_node valid_SDG_CFG_node)
lemma intra_SDG_path_intra_CFG_path:
assumes "n i-ns→⇩d* n'"
obtains as where "parent_node n -as→⇩ι* parent_node n'"
proof(atomize_elim)
from ‹n i-ns→⇩d* n'›
show "∃as. parent_node n -as→⇩ι* parent_node n'"
proof(induct rule:intra_SDG_path.induct)
case (iSp_Nil n)
from ‹valid_SDG_node n› have "valid_node (parent_node n)"
by(rule valid_SDG_CFG_node)
hence "parent_node n -[]→* parent_node n" by(rule empty_path)
thus ?case by(auto simp:intra_path_def)
next
case (iSp_Append_cdep n ns n'' n')
from ‹∃as. parent_node n -as→⇩ι* parent_node n''›
obtain as where "parent_node n -as→⇩ι* parent_node n''" by blast
from ‹n'' ⟶⇘cd⇙ n'› show ?case
proof(rule cdep_edge_cases)
assume "parent_node n'' controls parent_node n'"
then obtain as' where "parent_node n'' -as'→⇩ι* parent_node n'" and "as' ≠ []"
by(erule control_dependence_path)
with ‹parent_node n -as→⇩ι* parent_node n''›
have "parent_node n -as@as'→⇩ι* parent_node n'" by -(rule intra_path_Append)
thus ?thesis by blast
next
fix a Q r p fs a'
assume "valid_edge a" and "kind a = Q:r↪⇘p⇙fs" and "a' ∈ get_return_edges a"
and "parent_node n'' = targetnode a" and "parent_node n' = sourcenode a'"
then obtain a'' where "valid_edge a''" and "sourcenode a'' = targetnode a"
and "targetnode a'' = sourcenode a'" and "kind a'' = (λcf. False)⇩√"
by(auto dest:intra_proc_additional_edge)
hence "targetnode a -[a'']→⇩ι* sourcenode a'"
by(fastforce dest:path_edge simp:intra_path_def intra_kind_def)
with ‹parent_node n'' = targetnode a› ‹parent_node n' = sourcenode a'›
have "∃as'. parent_node n'' -as'→⇩ι* parent_node n' ∧ as' ≠ []" by fastforce
then obtain as' where "parent_node n'' -as'→⇩ι* parent_node n'" and "as' ≠ []"
by blast
with ‹parent_node n -as→⇩ι* parent_node n''›
have "parent_node n -as@as'→⇩ι* parent_node n'" by -(rule intra_path_Append)
thus ?thesis by blast
next
fix m assume "n'' = CFG_node m" and "m = parent_node n'"
with ‹parent_node n -as→⇩ι* parent_node n''› show ?thesis by fastforce
qed
next
case (iSp_Append_ddep n ns n'' V n')
from ‹∃as. parent_node n -as→⇩ι* parent_node n''›
obtain as where "parent_node n -as→⇩ι* parent_node n''" by blast
from ‹n'' -V→⇩d⇩d n'› have "n'' influences V in n'"
by(fastforce elim:SDG_edge.cases)
then obtain as' where "parent_node n'' -as'→⇩ι* parent_node n'"
by(auto simp:data_dependence_def)
with ‹parent_node n -as→⇩ι* parent_node n''›
have "parent_node n -as@as'→⇩ι* parent_node n'" by -(rule intra_path_Append)
thus ?case by blast
qed
qed
subsection ‹Control dependence paths in the SDG›
inductive cdep_SDG_path ::
"'node SDG_node ⇒ 'node SDG_node list ⇒ 'node SDG_node ⇒ bool"
("_ cd-_→⇩d* _" [51,0,0] 80)
where cdSp_Nil:
"valid_SDG_node n ⟹ n cd-[]→⇩d* n"
| cdSp_Append_cdep:
"⟦n cd-ns→⇩d* n''; n'' ⟶⇘cd⇙ n'⟧ ⟹ n cd-ns@[n'']→⇩d* n'"
lemma cdep_SDG_path_intra_SDG_path:
"n cd-ns→⇩d* n' ⟹ n i-ns→⇩d* n'"
by(induct rule:cdep_SDG_path.induct,auto intro:intra_SDG_path.intros)
lemma Entry_cdep_SDG_path:
assumes "(_Entry_) -as→⇩ι* n'" and "inner_node n'" and "¬ method_exit n'"
obtains ns where "CFG_node (_Entry_) cd-ns→⇩d* CFG_node n'"
and "ns ≠ []" and "∀n'' ∈ set ns. parent_node n'' ∈ set(sourcenodes as)"
proof(atomize_elim)
from ‹(_Entry_) -as→⇩ι* n'› ‹inner_node n'› ‹¬ method_exit n'›
show "∃ns. CFG_node (_Entry_) cd-ns→⇩d* CFG_node n' ∧ ns ≠ [] ∧
(∀n'' ∈ set ns. parent_node n'' ∈ set(sourcenodes as))"
proof(induct as arbitrary:n' rule:length_induct)
fix as n'
assume IH:"∀as'. length as' < length as ⟶
(∀n''. (_Entry_) -as'→⇩ι* n'' ⟶ inner_node n'' ⟶ ¬ method_exit n'' ⟶
(∃ns. CFG_node (_Entry_) cd-ns→⇩d* CFG_node n'' ∧ ns ≠ [] ∧
(∀nx∈set ns. parent_node nx ∈ set (sourcenodes as'))))"
and "(_Entry_) -as→⇩ι* n'" and "inner_node n'" and "¬ method_exit n'"
thus "∃ns. CFG_node (_Entry_) cd-ns→⇩d* CFG_node n' ∧ ns ≠ [] ∧
(∀n''∈set ns. parent_node n'' ∈ set (sourcenodes as))"
proof -
have "∃ax asx zs. (_Entry_) -ax#asx→⇩ι* n' ∧ n' ∉ set (sourcenodes (ax#asx)) ∧
as = (ax#asx)@zs"
proof(cases "n' ∈ set (sourcenodes as)")
case True
hence "∃n'' ∈ set(sourcenodes as). n' = n''" by simp
then obtain ns' ns'' where "sourcenodes as = ns'@n'#ns''"
and "∀n'' ∈ set ns'. n' ≠ n''"
by(fastforce elim!:split_list_first_propE)
from ‹sourcenodes as = ns'@n'#ns''› obtain xs ys ax
where "sourcenodes xs = ns'" and "as = xs@ax#ys"
and "sourcenode ax = n'"
by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
from ‹∀n'' ∈ set ns'. n' ≠ n''› ‹sourcenodes xs = ns'›
have "n' ∉ set(sourcenodes xs)" by fastforce
from ‹(_Entry_) -as→⇩ι* n'› ‹as = xs@ax#ys› have "(_Entry_) -xs@ax#ys→⇩ι* n'"
by simp
with ‹sourcenode ax = n'› have "(_Entry_) -xs→⇩ι* n'"
by(fastforce dest:path_split simp:intra_path_def)
with ‹inner_node n'› have "xs ≠ []"
by(fastforce elim:path.cases simp:intra_path_def)
with ‹n' ∉ set(sourcenodes xs)› ‹(_Entry_) -xs→⇩ι* n'› ‹as = xs@ax#ys›
show ?thesis by(cases xs) auto
next
case False
with ‹(_Entry_) -as→⇩ι* n'› ‹inner_node n'›
show ?thesis by(cases as)(auto elim:path.cases simp:intra_path_def)
qed
then obtain ax asx zs where "(_Entry_) -ax#asx→⇩ι* n'"
and "n' ∉ set (sourcenodes (ax#asx))" and "as = (ax#asx)@zs" by blast
show ?thesis
proof(cases "∀a' a''. a' ∈ set asx ∧ sourcenode a' = sourcenode a'' ∧
valid_edge a'' ∧ intra_kind(kind a'') ⟶ n' postdominates targetnode a''")
case True
have "(_Exit_) -[]→⇩ι* (_Exit_)"
by(fastforce intro:empty_path simp:intra_path_def)
hence "¬ n' postdominates (_Exit_)"
by(fastforce simp:postdominate_def sourcenodes_def method_exit_def)
from ‹(_Entry_) -ax#asx→⇩ι* n'› have "(_Entry_) -[]@ax#asx→⇩ι* n'" by simp
from ‹(_Entry_) -ax#asx→⇩ι* n'› have [simp]:"sourcenode ax = (_Entry_)"
and "valid_edge ax"
by(auto intro:path_split_Cons simp:intra_path_def)
from Entry_Exit_edge obtain a' where "sourcenode a' = (_Entry_)"
and "targetnode a' = (_Exit_)" and "valid_edge a'"
and "intra_kind(kind a')" by(auto simp:intra_kind_def)
with ‹(_Entry_) -[]@ax#asx→⇩ι* n'› ‹¬ n' postdominates (_Exit_)›
‹valid_edge ax› True ‹sourcenode ax = (_Entry_)›
‹n' ∉ set (sourcenodes (ax#asx))› ‹inner_node n'› ‹¬ method_exit n'›
have "sourcenode ax controls n'"
by -(erule which_node_intra_standard_control_dependence_source
[of _ _ _ _ _ _ a'],auto)
hence "CFG_node (_Entry_) ⟶⇘cd⇙ CFG_node n'"
by(fastforce intro:SDG_cdep_edge)
hence "CFG_node (_Entry_) cd-[]@[CFG_node (_Entry_)]→⇩d* CFG_node n'"
by(fastforce intro:cdSp_Append_cdep cdSp_Nil)
moreover
from ‹as = (ax#asx)@zs› have "(_Entry_) ∈ set(sourcenodes as)"
by(simp add:sourcenodes_def)
ultimately show ?thesis by fastforce
next
case False
hence "∃a' ∈ set asx. ∃a''. sourcenode a' = sourcenode a'' ∧ valid_edge a'' ∧
intra_kind(kind a'') ∧ ¬ n' postdominates targetnode a''"
by fastforce
then obtain ax' asx' asx'' where "asx = asx'@ax'#asx'' ∧
(∃a''. sourcenode ax' = sourcenode a'' ∧ valid_edge a'' ∧
intra_kind(kind a'') ∧ ¬ n' postdominates targetnode a'') ∧
(∀z ∈ set asx''. ¬ (∃a''. sourcenode z = sourcenode a'' ∧ valid_edge a'' ∧
intra_kind(kind a'') ∧ ¬ n' postdominates targetnode a''))"
by(blast elim!:split_list_last_propE)
then obtain ai where "asx = asx'@ax'#asx''"
and "sourcenode ax' = sourcenode ai"
and "valid_edge ai" and "intra_kind(kind ai)"
and "¬ n' postdominates targetnode ai"
and "∀z ∈ set asx''. ¬ (∃a''. sourcenode z = sourcenode a'' ∧
valid_edge a'' ∧ intra_kind(kind a'') ∧ ¬ n' postdominates targetnode a'')"
by blast
from ‹(_Entry_) -ax#asx→⇩ι* n'› ‹asx = asx'@ax'#asx''›
have "(_Entry_) -(ax#asx')@ax'#asx''→⇩ι* n'" by simp
from ‹n' ∉ set (sourcenodes (ax#asx))› ‹asx = asx'@ax'#asx''›
have "n' ∉ set (sourcenodes (ax'#asx''))"
by(auto simp:sourcenodes_def)
with ‹inner_node n'› ‹¬ n' postdominates targetnode ai›
‹n' ∉ set (sourcenodes (ax'#asx''))› ‹sourcenode ax' = sourcenode ai›
‹∀z ∈ set asx''. ¬ (∃a''. sourcenode z = sourcenode a'' ∧
valid_edge a'' ∧ intra_kind(kind a'') ∧ ¬ n' postdominates targetnode a'')›
‹valid_edge ai› ‹intra_kind(kind ai)› ‹¬ method_exit n'›
‹(_Entry_) -(ax#asx')@ax'#asx''→⇩ι* n'›
have "sourcenode ax' controls n'"
by(fastforce intro!:which_node_intra_standard_control_dependence_source)
hence "CFG_node (sourcenode ax') ⟶⇘cd⇙ CFG_node n'"
by(fastforce intro:SDG_cdep_edge)
from ‹(_Entry_) -(ax#asx')@ax'#asx''→⇩ι* n'›
have "(_Entry_) -ax#asx'→⇩ι* sourcenode ax'" and "valid_edge ax'"
by(auto intro:path_split simp:intra_path_def simp del:append_Cons)
from ‹asx = asx'@ax'#asx''› ‹as = (ax#asx)@zs›
have "length (ax#asx') < length as" by simp
from ‹valid_edge ax'› have "valid_node (sourcenode ax')" by simp
hence "inner_node (sourcenode ax')"
proof(cases "sourcenode ax'" rule:valid_node_cases)
case Entry
with ‹(_Entry_) -ax#asx'→⇩ι* sourcenode ax'›
have "(_Entry_) -ax#asx'→* (_Entry_)" by(simp add:intra_path_def)
hence False by(fastforce dest:path_Entry_target)
thus ?thesis by simp
next
case Exit
with ‹valid_edge ax'› have False by(rule Exit_source)
thus ?thesis by simp
qed simp
from ‹asx = asx'@ax'#asx''› ‹(_Entry_) -ax#asx→⇩ι* n'›
have "intra_kind (kind ax')" by(simp add:intra_path_def)
have "¬ method_exit (sourcenode ax')"
proof
assume "method_exit (sourcenode ax')"
thus False
proof(rule method_exit_cases)
assume "sourcenode ax' = (_Exit_)"
with ‹valid_edge ax'› show False by(rule Exit_source)
next
fix x Q f p assume " sourcenode ax' = sourcenode x"
and "valid_edge x" and "kind x = Q↩⇘p⇙f"
from ‹valid_edge x› ‹kind x = Q↩⇘p⇙f› ‹sourcenode ax' = sourcenode x›
‹valid_edge ax'› ‹intra_kind (kind ax')› show False
by(fastforce dest:return_edges_only simp:intra_kind_def)
qed
qed
with IH ‹length (ax#asx') < length as› ‹(_Entry_) -ax#asx'→⇩ι* sourcenode ax'›
‹inner_node (sourcenode ax')›
obtain ns where "CFG_node (_Entry_) cd-ns→⇩d* CFG_node (sourcenode ax')"
and "ns ≠ []"
and "∀n'' ∈ set ns. parent_node n'' ∈ set(sourcenodes (ax#asx'))"
by blast
from ‹CFG_node (_Entry_) cd-ns→⇩d* CFG_node (sourcenode ax')›
‹CFG_node (sourcenode ax') ⟶⇘cd⇙ CFG_node n'›
have "CFG_node (_Entry_) cd-ns@[CFG_node (sourcenode ax')]→⇩d* CFG_node n'"
by(fastforce intro:cdSp_Append_cdep)
from ‹as = (ax#asx)@zs› ‹asx = asx'@ax'#asx''›
have "sourcenode ax' ∈ set(sourcenodes as)" by(simp add:sourcenodes_def)
with ‹∀n'' ∈ set ns. parent_node n'' ∈ set(sourcenodes (ax#asx'))›
‹as = (ax#asx)@zs› ‹asx = asx'@ax'#asx''›
have "∀n'' ∈ set (ns@[CFG_node (sourcenode ax')]).
parent_node n'' ∈ set(sourcenodes as)"
by(fastforce simp:sourcenodes_def)
with ‹CFG_node (_Entry_) cd-ns@[CFG_node (sourcenode ax')]→⇩d* CFG_node n'›
show ?thesis by fastforce
qed
qed
qed
qed
lemma in_proc_cdep_SDG_path:
assumes "n -as→⇩ι* n'" and "n ≠ n'" and "n' ≠ (_Exit_)" and "valid_edge a"
and "kind a = Q:r↪⇘p⇙fs" and "targetnode a = n"
obtains ns where "CFG_node n cd-ns→⇩d* CFG_node n'"
and "ns ≠ []" and "∀n'' ∈ set ns. parent_node n'' ∈ set(sourcenodes as)"
proof(atomize_elim)
show "∃ns. CFG_node n cd-ns→⇩d* CFG_node n' ∧
ns ≠ [] ∧ (∀n''∈set ns. parent_node n'' ∈ set (sourcenodes as))"
proof(cases "∀ax. valid_edge ax ∧ sourcenode ax = n' ⟶
ax ∉ get_return_edges a")
case True
from ‹n -as→⇩ι* n'› ‹n ≠ n'› ‹n' ≠ (_Exit_)›
‹∀ax. valid_edge ax ∧ sourcenode ax = n' ⟶ ax ∉ get_return_edges a›
show "∃ns. CFG_node n cd-ns→⇩d* CFG_node n' ∧ ns ≠ [] ∧
(∀n'' ∈ set ns. parent_node n'' ∈ set(sourcenodes as))"
proof(induct as arbitrary:n' rule:length_induct)
fix as n'
assume IH:"∀as'. length as' < length as ⟶
(∀n''. n -as'→⇩ι* n'' ⟶ n ≠ n'' ⟶ n'' ≠ (_Exit_) ⟶
(∀ax. valid_edge ax ∧ sourcenode ax = n'' ⟶ ax ∉ get_return_edges a) ⟶
(∃ns. CFG_node n cd-ns→⇩d* CFG_node n'' ∧ ns ≠ [] ∧
(∀n''∈set ns. parent_node n'' ∈ set (sourcenodes as'))))"
and "n -as→⇩ι* n'" and "n ≠ n'" and "n' ≠ (_Exit_)"
and "∀ax. valid_edge ax ∧ sourcenode ax = n' ⟶ ax ∉ get_return_edges a"
show "∃ns. CFG_node n cd-ns→⇩d* CFG_node n' ∧ ns ≠ [] ∧
(∀n''∈set ns. parent_node n'' ∈ set (sourcenodes as))"
proof(cases "method_exit n'")
case True
thus ?thesis
proof(rule method_exit_cases)
assume "n' = (_Exit_)"
with ‹n' ≠ (_Exit_)› have False by simp
thus ?thesis by simp
next
fix a' Q' f' p'
assume "n' = sourcenode a'" and "valid_edge a'" and "kind a' = Q'↩⇘p'⇙f'"
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› have "get_proc(targetnode a) = p"
by(rule get_proc_call)
from ‹n -as→⇩ι* n'› have "get_proc n = get_proc n'"
by(rule intra_path_get_procs)
with ‹get_proc(targetnode a) = p› ‹targetnode a = n›
have "get_proc (targetnode a) = get_proc n'" by simp
from ‹valid_edge a'› ‹kind a' = Q'↩⇘p'⇙f'›
have "get_proc (sourcenode a') = p'" by(rule get_proc_return)
with ‹n' = sourcenode a'› ‹get_proc (targetnode a) = get_proc n'›
‹get_proc (targetnode a) = p› have "p = p'" by simp
with ‹valid_edge a'› ‹kind a' = Q'↩⇘p'⇙f'›
obtain ax where "valid_edge ax" and "∃Q r fs. kind ax = Q:r↪⇘p⇙fs"
and "a' ∈ get_return_edges ax" by(auto dest:return_needs_call)
hence "CFG_node (targetnode ax) ⟶⇘cd⇙ CFG_node (sourcenode a')"
by(fastforce intro:SDG_proc_entry_exit_cdep)
with ‹valid_edge ax›
have "CFG_node (targetnode ax) cd-[]@[CFG_node (targetnode ax)]→⇩d*
CFG_node (sourcenode a')"
by(fastforce intro:cdep_SDG_path.intros)
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹valid_edge ax›
‹∃Q r fs. kind ax = Q:r↪⇘p⇙fs› have "targetnode a = targetnode ax"
by(fastforce intro:same_proc_call_unique_target)
from ‹n -as→⇩ι* n'› ‹n ≠ n'›
have "as ≠ []" by(fastforce elim:path.cases simp:intra_path_def)
with ‹n -as→⇩ι* n'› have "hd (sourcenodes as) = n"
by(fastforce intro:path_sourcenode simp:intra_path_def)
moreover
from ‹as ≠ []› have "hd (sourcenodes as) ∈ set (sourcenodes as)"
by(fastforce intro:hd_in_set simp:sourcenodes_def)
ultimately have "n ∈ set (sourcenodes as)" by simp
with ‹n' = sourcenode a'› ‹targetnode a = targetnode ax›
‹targetnode a = n›
‹CFG_node (targetnode ax) cd-[]@[CFG_node (targetnode ax)]→⇩d*
CFG_node (sourcenode a')›
show ?thesis by fastforce
qed
next
case False
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› obtain a'
where "a' ∈ get_return_edges a"
by(fastforce dest:get_return_edge_call)
with ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› obtain Q' f' where "kind a' = Q'↩⇘p⇙f'"
by(fastforce dest!:call_return_edges)
with ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹a' ∈ get_return_edges a› obtain a''
where "valid_edge a''" and "sourcenode a'' = targetnode a"
and "targetnode a'' = sourcenode a'" and "kind a'' = (λcf. False)⇩√"
by -(drule intra_proc_additional_edge,auto)
from ‹valid_edge a› ‹a' ∈ get_return_edges a› have "valid_edge a'"
by(rule get_return_edges_valid)
have "∃ax asx zs. n -ax#asx→⇩ι* n' ∧ n' ∉ set (sourcenodes (ax#asx)) ∧
as = (ax#asx)@zs"
proof(cases "n' ∈ set (sourcenodes as)")
case True
hence "∃n'' ∈ set(sourcenodes as). n' = n''" by simp
then obtain ns' ns'' where "sourcenodes as = ns'@n'#ns''"
and "∀n'' ∈ set ns'. n' ≠ n''"
by(fastforce elim!:split_list_first_propE)
from ‹sourcenodes as = ns'@n'#ns''› obtain xs ys ax
where "sourcenodes xs = ns'" and "as = xs@ax#ys"
and "sourcenode ax = n'"
by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
from ‹∀n'' ∈ set ns'. n' ≠ n''› ‹sourcenodes xs = ns'›
have "n' ∉ set(sourcenodes xs)" by fastforce
from ‹n -as→⇩ι* n'› ‹as = xs@ax#ys› have "n -xs@ax#ys→⇩ι* n'" by simp
with ‹sourcenode ax = n'› have "n -xs→⇩ι* n'"
by(fastforce dest:path_split simp:intra_path_def)
with ‹n ≠ n'› have "xs ≠ []" by(fastforce simp:intra_path_def)
with ‹n' ∉ set(sourcenodes xs)› ‹n -xs→⇩ι* n'› ‹as = xs@ax#ys› show ?thesis
by(cases xs) auto
next
case False
with ‹n -as→⇩ι* n'› ‹n ≠ n'›
show ?thesis by(cases as)(auto simp:intra_path_def)
qed
then obtain ax asx zs where "n -ax#asx→⇩ι* n'"
and "n' ∉ set (sourcenodes (ax#asx))" and "as = (ax#asx)@zs" by blast
from ‹n -ax#asx→⇩ι* n'› ‹n' ≠ (_Exit_)› have "inner_node n'"
by(fastforce intro:path_valid_node simp:inner_node_def intra_path_def)
from ‹valid_edge a› ‹targetnode a = n› have "valid_node n" by fastforce
show ?thesis
proof(cases "∀a' a''. a' ∈ set asx ∧ sourcenode a' = sourcenode a'' ∧
valid_edge a'' ∧ intra_kind(kind a'') ⟶
n' postdominates targetnode a''")
case True
from ‹targetnode a = n› ‹sourcenode a'' = targetnode a›
‹kind a'' = (λcf. False)⇩√›
have "sourcenode a'' = n" and "intra_kind(kind a'')"
by(auto simp:intra_kind_def)
{ fix as' assume "targetnode a'' -as'→⇩ι* n'"
from ‹valid_edge a'› ‹targetnode a'' = sourcenode a'›
‹a' ∈ get_return_edges a›
‹∀ax. valid_edge ax ∧ sourcenode ax = n' ⟶ ax ∉ get_return_edges a›
have "targetnode a'' ≠ n'" by fastforce
with ‹targetnode a'' -as'→⇩ι* n'› obtain ax' where "valid_edge ax'"
and "targetnode a'' = sourcenode ax'" and "intra_kind(kind ax')"
by(clarsimp simp:intra_path_def)(erule path.cases,fastforce+)
from ‹valid_edge a'› ‹kind a' = Q'↩⇘p⇙f'› ‹valid_edge ax'›
‹targetnode a'' = sourcenode a'› ‹targetnode a'' = sourcenode ax'›
‹intra_kind(kind ax')›
have False by(fastforce dest:return_edges_only simp:intra_kind_def) }
hence "¬ n' postdominates targetnode a''"
by(fastforce elim:postdominate_implies_inner_path)
from ‹n -ax#asx→⇩ι* n'› have "sourcenode ax = n"
by(auto intro:path_split_Cons simp:intra_path_def)
from ‹n -ax#asx→⇩ι* n'› have "n -[]@ax#asx→⇩ι* n'" by simp
from this ‹sourcenode a'' = n› ‹sourcenode ax = n› True
‹n' ∉ set (sourcenodes (ax#asx))› ‹valid_edge a''› ‹intra_kind(kind a'')›
‹inner_node n'› ‹¬ method_exit n'› ‹¬ n' postdominates targetnode a''›
have "n controls n'"
by(fastforce intro!:which_node_intra_standard_control_dependence_source)
hence "CFG_node n ⟶⇘cd⇙ CFG_node n'"
by(fastforce intro:SDG_cdep_edge)
with ‹valid_node n› have "CFG_node n cd-[]@[CFG_node n]→⇩d* CFG_node n'"
by(fastforce intro:cdSp_Append_cdep cdSp_Nil)
moreover
from ‹as = (ax#asx)@zs› ‹sourcenode ax = n› have "n ∈ set(sourcenodes as)"
by(simp add:sourcenodes_def)
ultimately show ?thesis by fastforce
next
case False
hence "∃a' ∈ set asx. ∃a''. sourcenode a' = sourcenode a'' ∧
valid_edge a'' ∧ intra_kind(kind a'') ∧
¬ n' postdominates targetnode a''"
by fastforce
then obtain ax' asx' asx'' where "asx = asx'@ax'#asx'' ∧
(∃a''. sourcenode ax' = sourcenode a'' ∧ valid_edge a'' ∧
intra_kind(kind a'') ∧ ¬ n' postdominates targetnode a'') ∧
(∀z ∈ set asx''. ¬ (∃a''. sourcenode z = sourcenode a'' ∧
valid_edge a'' ∧ intra_kind(kind a'') ∧
¬ n' postdominates targetnode a''))"
by(blast elim!:split_list_last_propE)
then obtain ai where "asx = asx'@ax'#asx''"
and "sourcenode ax' = sourcenode ai"
and "valid_edge ai" and "intra_kind(kind ai)"
and "¬ n' postdominates targetnode ai"
and "∀z ∈ set asx''. ¬ (∃a''. sourcenode z = sourcenode a'' ∧
valid_edge a'' ∧ intra_kind(kind a'') ∧
¬ n' postdominates targetnode a'')"
by blast
from ‹asx = asx'@ax'#asx''› ‹n -ax#asx→⇩ι* n'›
have "n -(ax#asx')@ax'#asx''→⇩ι* n'" by simp
from ‹n' ∉ set (sourcenodes (ax#asx))› ‹asx = asx'@ax'#asx''›
have "n' ∉ set (sourcenodes (ax'#asx''))"
by(auto simp:sourcenodes_def)
with ‹inner_node n'› ‹¬ n' postdominates targetnode ai›
‹n -(ax#asx')@ax'#asx''→⇩ι* n'› ‹sourcenode ax' = sourcenode ai›
‹∀z ∈ set asx''. ¬ (∃a''. sourcenode z = sourcenode a'' ∧
valid_edge a'' ∧ intra_kind(kind a'') ∧
¬ n' postdominates targetnode a'')›
‹valid_edge ai› ‹intra_kind(kind ai)› ‹¬ method_exit n'›
have "sourcenode ax' controls n'"
by(fastforce intro!:which_node_intra_standard_control_dependence_source)
hence "CFG_node (sourcenode ax') ⟶⇘cd⇙ CFG_node n'"
by(fastforce intro:SDG_cdep_edge)
from ‹n -(ax#asx')@ax'#asx''→⇩ι* n'›
have "n -ax#asx'→⇩ι* sourcenode ax'" and "valid_edge ax'"
by(auto intro:path_split simp:intra_path_def simp del:append_Cons)
from ‹asx = asx'@ax'#asx''› ‹as = (ax#asx)@zs›
have "length (ax#asx') < length as" by simp
from ‹as = (ax#asx)@zs› ‹asx = asx'@ax'#asx''›
have "sourcenode ax' ∈ set(sourcenodes as)" by(simp add:sourcenodes_def)
show ?thesis
proof(cases "n = sourcenode ax'")
case True
with ‹CFG_node (sourcenode ax') ⟶⇘cd⇙ CFG_node n'› ‹valid_edge ax'›
have "CFG_node n cd-[]@[CFG_node n]→⇩d* CFG_node n'"
by(fastforce intro:cdSp_Append_cdep cdSp_Nil)
with ‹sourcenode ax' ∈ set(sourcenodes as)› True show ?thesis by fastforce
next
case False
from ‹valid_edge ax'› have "sourcenode ax' ≠ (_Exit_)"
by -(rule ccontr,fastforce elim!:Exit_source)
from ‹n -ax#asx'→⇩ι* sourcenode ax'› have "n = sourcenode ax"
by(fastforce intro:path_split_Cons simp:intra_path_def)
show ?thesis
proof(cases "∀ax. valid_edge ax ∧ sourcenode ax = sourcenode ax' ⟶
ax ∉ get_return_edges a")
case True
from ‹asx = asx'@ax'#asx''› ‹n -ax#asx→⇩ι* n'›
have "intra_kind (kind ax')" by(simp add:intra_path_def)
have "¬ method_exit (sourcenode ax')"
proof
assume "method_exit (sourcenode ax')"
thus False
proof(rule method_exit_cases)
assume "sourcenode ax' = (_Exit_)"
with ‹valid_edge ax'› show False by(rule Exit_source)
next
fix x Q f p assume " sourcenode ax' = sourcenode x"
and "valid_edge x" and "kind x = Q↩⇘p⇙f"
from ‹valid_edge x› ‹kind x = Q↩⇘p⇙f› ‹sourcenode ax' = sourcenode x›
‹valid_edge ax'› ‹intra_kind (kind ax')› show False
by(fastforce dest:return_edges_only simp:intra_kind_def)
qed
qed
with IH ‹length (ax#asx') < length as› ‹n -ax#asx'→⇩ι* sourcenode ax'›
‹n ≠ sourcenode ax'› ‹sourcenode ax' ≠ (_Exit_)› True
obtain ns where "CFG_node n cd-ns→⇩d* CFG_node (sourcenode ax')"
and "ns ≠ []"
and "∀n''∈set ns. parent_node n'' ∈ set (sourcenodes (ax#asx'))"
by blast
from ‹CFG_node n cd-ns→⇩d* CFG_node (sourcenode ax')›
‹CFG_node (sourcenode ax') ⟶⇘cd⇙ CFG_node n'›
have "CFG_node n cd-ns@[CFG_node (sourcenode ax')]→⇩d* CFG_node n'"
by(rule cdSp_Append_cdep)
moreover
from ‹∀n''∈set ns. parent_node n'' ∈ set (sourcenodes (ax#asx'))›
‹asx = asx'@ax'#asx''› ‹as = (ax#asx)@zs›
‹sourcenode ax' ∈ set(sourcenodes as)›
have "∀n''∈set (ns@[CFG_node (sourcenode ax')]).
parent_node n'' ∈ set (sourcenodes as)"
by(fastforce simp:sourcenodes_def)
ultimately show ?thesis by fastforce
next
case False
then obtain ai' where "valid_edge ai'"
and "sourcenode ai' = sourcenode ax'"
and "ai' ∈ get_return_edges a" by blast
with ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹targetnode a = n›
have "CFG_node n ⟶⇘cd⇙ CFG_node (sourcenode ax')"
by(fastforce intro!:SDG_proc_entry_exit_cdep[of _ _ _ _ _ _ ai'])
with ‹valid_node n›
have "CFG_node n cd-[]@[CFG_node n]→⇩d* CFG_node (sourcenode ax')"
by(fastforce intro:cdSp_Append_cdep cdSp_Nil)
with ‹CFG_node (sourcenode ax') ⟶⇘cd⇙ CFG_node n'›
have "CFG_node n cd-[CFG_node n]@[CFG_node (sourcenode ax')]→⇩d*
CFG_node n'"
by(fastforce intro:cdSp_Append_cdep)
moreover
from ‹sourcenode ax' ∈ set(sourcenodes as)› ‹n = sourcenode ax›
‹as = (ax#asx)@zs›
have "∀n''∈set ([CFG_node n]@[CFG_node (sourcenode ax')]).
parent_node n'' ∈ set (sourcenodes as)"
by(fastforce simp:sourcenodes_def)
ultimately show ?thesis by fastforce
qed
qed
qed
qed
qed
next
case False
then obtain a' where "valid_edge a'" and "sourcenode a' = n'"
and "a' ∈ get_return_edges a" by auto
with ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹targetnode a = n›
have "CFG_node n ⟶⇘cd⇙ CFG_node n'" by(fastforce intro:SDG_proc_entry_exit_cdep)
with ‹valid_edge a› ‹targetnode a = n›[THEN sym]
have "CFG_node n cd-[]@[CFG_node n]→⇩d* CFG_node n'"
by(fastforce intro:cdep_SDG_path.intros)
from ‹n -as→⇩ι* n'› ‹n ≠ n'› have "as ≠ []"
by(fastforce elim:path.cases simp:intra_path_def)
with ‹n -as→⇩ι* n'› have "hd (sourcenodes as) = n"
by(fastforce intro:path_sourcenode simp:intra_path_def)
with ‹as ≠ []› have "n ∈ set (sourcenodes as)"
by(fastforce intro:hd_in_set simp:sourcenodes_def)
with ‹CFG_node n cd-[]@[CFG_node n]→⇩d* CFG_node n'›
show ?thesis by auto
qed
qed
subsection ‹Paths consisting of calls and control dependences›
inductive call_cdep_SDG_path ::
"'node SDG_node ⇒ 'node SDG_node list ⇒ 'node SDG_node ⇒ bool"
("_ cc-_→⇩d* _" [51,0,0] 80)
where ccSp_Nil:
"valid_SDG_node n ⟹ n cc-[]→⇩d* n"
| ccSp_Append_cdep:
"⟦n cc-ns→⇩d* n''; n'' ⟶⇘cd⇙ n'⟧ ⟹ n cc-ns@[n'']→⇩d* n'"
| ccSp_Append_call:
"⟦n cc-ns→⇩d* n''; n'' -p→⇘call⇙ n'⟧ ⟹ n cc-ns@[n'']→⇩d* n'"
lemma cc_SDG_path_Append:
"⟦n'' cc-ns'→⇩d* n'; n cc-ns→⇩d* n''⟧ ⟹ n cc-ns@ns'→⇩d* n'"
by(induct rule:call_cdep_SDG_path.induct,
auto intro:call_cdep_SDG_path.intros simp:append_assoc[THEN sym]
simp del:append_assoc)
lemma cdep_SDG_path_cc_SDG_path:
"n cd-ns→⇩d* n' ⟹ n cc-ns→⇩d* n'"
by(induct rule:cdep_SDG_path.induct,auto intro:call_cdep_SDG_path.intros)
lemma Entry_cc_SDG_path_to_inner_node:
assumes "valid_SDG_node n" and "parent_node n ≠ (_Exit_)"
obtains ns where "CFG_node (_Entry_) cc-ns→⇩d* n"
proof(atomize_elim)
obtain m where "m = parent_node n" by simp
from ‹valid_SDG_node n› have "valid_node (parent_node n)"
by(rule valid_SDG_CFG_node)
thus "∃ns. CFG_node (_Entry_) cc-ns→⇩d* n"
proof(cases "parent_node n" rule:valid_node_cases)
case Entry
with ‹valid_SDG_node n› have "n = CFG_node (_Entry_)"
by(rule valid_SDG_node_parent_Entry)
with ‹valid_SDG_node n› show ?thesis by(fastforce intro:ccSp_Nil)
next
case Exit
with ‹parent_node n ≠ (_Exit_)› have False by simp
thus ?thesis by simp
next
case inner
with ‹m = parent_node n› obtain asx where "(_Entry_) -asx→⇩√* m"
by(fastforce dest:Entry_path inner_is_valid)
then obtain as where "(_Entry_) -as→⇩√* m"
and "∀a' ∈ set as. intra_kind(kind a') ∨ (∃Q r p fs. kind a' = Q:r↪⇘p⇙fs)"
by -(erule valid_Entry_path_ascending_path,fastforce)
from ‹inner_node (parent_node n)› ‹m = parent_node n›
have "inner_node m" by simp
with ‹(_Entry_) -as→⇩√* m› ‹m = parent_node n› ‹valid_SDG_node n›
‹∀a' ∈ set as. intra_kind(kind a') ∨ (∃Q r p fs. kind a' = Q:r↪⇘p⇙fs)›
show ?thesis
proof(induct as arbitrary:m n rule:length_induct)
fix as m n
assume IH:"∀as'. length as' < length as ⟶
(∀m'. (_Entry_) -as'→⇩√* m' ⟶
(∀n'. m' = parent_node n' ⟶ valid_SDG_node n' ⟶
(∀a' ∈ set as'. intra_kind(kind a') ∨ (∃Q r p fs. kind a' = Q:r↪⇘p⇙fs)) ⟶
inner_node m' ⟶ (∃ns. CFG_node (_Entry_) cc-ns→⇩d* n')))"
and "(_Entry_) -as→⇩√* m"
and "m = parent_node n" and "valid_SDG_node n" and "inner_node m"
and "∀a' ∈ set as. intra_kind(kind a') ∨ (∃Q r p fs. kind a' = Q:r↪⇘p⇙fs)"
show "∃ns. CFG_node (_Entry_) cc-ns→⇩d* n"
proof(cases "∀a' ∈ set as. intra_kind(kind a')")
case True
with ‹(_Entry_) -as→⇩√* m› have "(_Entry_) -as→⇩ι* m"
by(fastforce simp:intra_path_def vp_def)
have "¬ method_exit m"
proof
assume "method_exit m"
thus False
proof(rule method_exit_cases)
assume "m = (_Exit_)"
with ‹inner_node m› show False by(simp add:inner_node_def)
next
fix a Q f p assume "m = sourcenode a" and "valid_edge a"
and "kind a = Q↩⇘p⇙f"
from ‹(_Entry_) -as→⇩ι* m› have "get_proc m = Main"
by(fastforce dest:intra_path_get_procs simp:get_proc_Entry)
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f›
have "get_proc (sourcenode a) = p" by(rule get_proc_return)
with ‹get_proc m = Main› ‹m = sourcenode a› have "p = Main" by simp
with ‹valid_edge a› ‹kind a = Q↩⇘p⇙f› show False
by(fastforce intro:Main_no_return_source)
qed
qed
with ‹inner_node m› ‹(_Entry_) -as→⇩ι* m›
obtain ns where "CFG_node (_Entry_) cd-ns→⇩d* CFG_node m"
and "ns ≠ []" and "∀n'' ∈ set ns. parent_node n'' ∈ set(sourcenodes as)"
by -(erule Entry_cdep_SDG_path)
then obtain n' where "n' ⟶⇘cd⇙ CFG_node m"
and "parent_node n' ∈ set(sourcenodes as)"
by -(erule cdep_SDG_path.cases,auto)
from ‹parent_node n' ∈ set(sourcenodes as)› obtain ms ms'
where "sourcenodes as = ms@(parent_node n')#ms'"
by(fastforce dest:split_list simp:sourcenodes_def)
then obtain as' a as'' where "ms = sourcenodes as'"
and "ms' = sourcenodes as''" and "as = as'@a#as''"
and "parent_node n' = sourcenode a"
by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
with ‹(_Entry_) -as→⇩ι* m› have "(_Entry_) -as'→⇩ι* parent_node n'"
by(fastforce intro:path_split simp:intra_path_def)
from ‹n' ⟶⇘cd⇙ CFG_node m› have "valid_SDG_node n'"
by(rule SDG_edge_valid_SDG_node)
hence n'_cases:
"n' = CFG_node (parent_node n') ∨ CFG_node (parent_node n') ⟶⇘cd⇙ n'"
by(rule valid_SDG_node_cases)
show ?thesis
proof(cases "as' = []")
case True
with ‹(_Entry_) -as'→⇩ι* parent_node n'› have "parent_node n' = (_Entry_)"
by(fastforce simp:intra_path_def)
from n'_cases have "∃ns. CFG_node (_Entry_) cd-ns→⇩d* CFG_node m"
proof
assume "n' = CFG_node (parent_node n')"
with ‹n' ⟶⇘cd⇙ CFG_node m› ‹parent_node n' = (_Entry_)›
have "CFG_node (_Entry_) cd-[]@[CFG_node (_Entry_)]→⇩d* CFG_node m"
by -(rule cdSp_Append_cdep,rule cdSp_Nil,auto)
thus ?thesis by fastforce
next
assume "CFG_node (parent_node n') ⟶⇘cd⇙ n'"
with ‹parent_node n' = (_Entry_)›
have "CFG_node (_Entry_) cd-[]@[CFG_node (_Entry_)]→⇩d* n'"
by -(rule cdSp_Append_cdep,rule cdSp_Nil,auto)
with ‹n' ⟶⇘cd⇙ CFG_node m›
have "CFG_node (_Entry_) cd-[CFG_node (_Entry_)]@[n']→⇩d* CFG_node m"
by(fastforce intro:cdSp_Append_cdep)
thus ?thesis by fastforce
qed
then obtain ns where "CFG_node (_Entry_) cc-ns→⇩d* CFG_node m"
by(fastforce intro:cdep_SDG_path_cc_SDG_path)
show ?thesis
proof(cases "n = CFG_node m")
case True
with ‹CFG_node (_Entry_) cc-ns→⇩d* CFG_node m›
show ?thesis by fastforce
next
case False
with ‹inner_node m› ‹valid_SDG_node n› ‹m = parent_node n›
have "CFG_node m ⟶⇘cd⇙ n"
by(fastforce intro:SDG_parent_cdep_edge inner_is_valid)
with ‹CFG_node (_Entry_) cc-ns→⇩d* CFG_node m›
have "CFG_node (_Entry_) cc-ns@[CFG_node m]→⇩d* n"
by(fastforce intro:ccSp_Append_cdep)
thus ?thesis by fastforce
qed
next
case False
with ‹as = as'@a#as''› have "length as' < length as" by simp
from ‹(_Entry_) -as'→⇩ι* parent_node n'› have "valid_node (parent_node n')"
by(fastforce intro:path_valid_node simp:intra_path_def)
hence "inner_node (parent_node n')"
proof(cases "parent_node n'" rule:valid_node_cases)
case Entry
with ‹(_Entry_) -as'→⇩ι* (parent_node n')›
have "(_Entry_) -as'→* (_Entry_)" by(fastforce simp:intra_path_def)
with False have False by fastforce
thus ?thesis by simp
next
case Exit
with ‹n' ⟶⇘cd⇙ CFG_node m› have "n' = CFG_node (_Exit_)"
by -(rule valid_SDG_node_parent_Exit,erule SDG_edge_valid_SDG_node,simp)
with ‹n' ⟶⇘cd⇙ CFG_node m› Exit have False
by simp(erule Exit_no_SDG_edge_source)
thus ?thesis by simp
next
case inner
thus ?thesis by simp
qed
from ‹valid_node (parent_node n')›
have "valid_SDG_node (CFG_node (parent_node n'))" by simp
from ‹(_Entry_) -as'→⇩ι* (parent_node n')›
have "(_Entry_) -as'→⇩√* (parent_node n')"
by(rule intra_path_vp)
from ‹∀a' ∈ set as. intra_kind(kind a') ∨ (∃Q r p fs. kind a' = Q:r↪⇘p⇙fs)›
‹as = as'@a#as''›
have "∀a' ∈ set as'. intra_kind(kind a') ∨ (∃Q r p fs. kind a' = Q:r↪⇘p⇙fs)"
by auto
with IH ‹length as' < length as› ‹(_Entry_) -as'→⇩√* (parent_node n')›
‹valid_SDG_node (CFG_node (parent_node n'))› ‹inner_node (parent_node n')›
obtain ns where "CFG_node (_Entry_) cc-ns→⇩d* CFG_node (parent_node n')"
apply(erule_tac x="as'" in allE) apply clarsimp
apply(erule_tac x="(parent_node n')" in allE) apply clarsimp
apply(erule_tac x="CFG_node (parent_node n')" in allE) by clarsimp
from n'_cases have "∃ns. CFG_node (_Entry_) cc-ns→⇩d* n'"
proof
assume "n' = CFG_node (parent_node n')"
with ‹CFG_node (_Entry_) cc-ns→⇩d* CFG_node (parent_node n')›
show ?thesis by fastforce
next
assume "CFG_node (parent_node n') ⟶⇘cd⇙ n'"
with ‹CFG_node (_Entry_) cc-ns→⇩d* CFG_node (parent_node n')›
have "CFG_node (_Entry_) cc-ns@[CFG_node (parent_node n')]→⇩d* n'"
by(fastforce intro:ccSp_Append_cdep)
thus ?thesis by fastforce
qed
then obtain ns' where "CFG_node (_Entry_) cc-ns'→⇩d* n'" by blast
with ‹n' ⟶⇘cd⇙ CFG_node m›
have "CFG_node (_Entry_) cc-ns'@[n']→⇩d* CFG_node m"
by(fastforce intro:ccSp_Append_cdep)
show ?thesis
proof(cases "n = CFG_node m")
case True
with ‹CFG_node (_Entry_) cc-ns'@[n']→⇩d* CFG_node m›
show ?thesis by fastforce
next
case False
with ‹inner_node m› ‹valid_SDG_node n› ‹m = parent_node n›
have "CFG_node m ⟶⇘cd⇙ n"
by(fastforce intro:SDG_parent_cdep_edge inner_is_valid)
with ‹CFG_node (_Entry_) cc-ns'@[n']→⇩d* CFG_node m›
have "CFG_node (_Entry_) cc-(ns'@[n'])@[CFG_node m]→⇩d* n"
by(fastforce intro:ccSp_Append_cdep)
thus ?thesis by fastforce
qed
qed
next
case False
hence "∃a' ∈ set as. ¬ intra_kind (kind a')" by fastforce
then obtain a as' as'' where "as = as'@a#as''" and "¬ intra_kind (kind a)"
and "∀a' ∈ set as''. intra_kind (kind a')"
by(fastforce elim!:split_list_last_propE)
from ‹∀a' ∈ set as. intra_kind(kind a') ∨ (∃Q r p fs. kind a' = Q:r↪⇘p⇙fs)›
‹as = as'@a#as''› ‹¬ intra_kind (kind a)›
obtain Q r p fs where "kind a = Q:r↪⇘p⇙fs"
and "∀a' ∈ set as'. intra_kind(kind a') ∨ (∃Q r p fs. kind a' = Q:r↪⇘p⇙fs)"
by auto
from ‹as = as'@a#as''› have "length as' < length as" by fastforce
from ‹(_Entry_) -as→⇩√* m› ‹as = as'@a#as''›
have "(_Entry_) -as'→⇩√* sourcenode a" and "valid_edge a"
and "targetnode a -as''→⇩√* m"
by(auto intro:vp_split)
hence "valid_SDG_node (CFG_node (sourcenode a))" by simp
have "∃ns'. CFG_node (_Entry_) cc-ns'→⇩d* CFG_node m"
proof(cases "targetnode a = m")
case True
with ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs›
have "CFG_node (sourcenode a) -p→⇘call⇙ CFG_node m"
by(fastforce intro:SDG_call_edge)
have "∃ns. CFG_node (_Entry_) cc-ns→⇩d* CFG_node (sourcenode a)"
proof(cases "as' = []")
case True
with ‹(_Entry_) -as'→⇩√* sourcenode a› have "(_Entry_) = sourcenode a"
by(fastforce simp:vp_def)
with ‹CFG_node (sourcenode a) -p→⇘call⇙ CFG_node m›
have "CFG_node (_Entry_) cc-[]→⇩d* CFG_node (sourcenode a)"
by(fastforce intro:ccSp_Nil SDG_edge_valid_SDG_node)
thus ?thesis by fastforce
next
case False
from ‹valid_edge a› have "valid_node (sourcenode a)" by simp
hence "inner_node (sourcenode a)"
proof(cases "sourcenode a" rule:valid_node_cases)
case Entry
with ‹(_Entry_) -as'→⇩√* sourcenode a›
have "(_Entry_) -as'→* (_Entry_)" by(fastforce simp:vp_def)
with False have False by fastforce
thus ?thesis by simp
next
case Exit
with ‹valid_edge a› have False by -(erule Exit_source)
thus ?thesis by simp
next
case inner
thus ?thesis by simp
qed
with IH ‹length as' < length as› ‹(_Entry_) -as'→⇩√* sourcenode a›
‹valid_SDG_node (CFG_node (sourcenode a))›
‹∀a' ∈ set as'. intra_kind(kind a') ∨ (∃Q r p fs. kind a' = Q:r↪⇘p⇙fs)›
obtain ns where "CFG_node (_Entry_) cc-ns→⇩d* CFG_node (sourcenode a)"
apply(erule_tac x="as'" in allE) apply clarsimp
apply(erule_tac x="sourcenode a" in allE) apply clarsimp
apply(erule_tac x="CFG_node (sourcenode a)" in allE) by clarsimp
thus ?thesis by fastforce
qed
then obtain ns where "CFG_node (_Entry_) cc-ns→⇩d* CFG_node (sourcenode a)"
by blast
with ‹CFG_node (sourcenode a) -p→⇘call⇙ CFG_node m›
show ?thesis by(fastforce intro:ccSp_Append_call)
next
case False
from ‹targetnode a -as''→⇩√* m› ‹∀a' ∈ set as''. intra_kind (kind a')›
have "targetnode a -as''→⇩ι* m" by(fastforce simp:vp_def intra_path_def)
hence "get_proc (targetnode a) = get_proc m" by(rule intra_path_get_procs)
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› have "get_proc (targetnode a) = p"
by(rule get_proc_call)
from ‹inner_node m› ‹valid_edge a› ‹targetnode a -as''→⇩ι* m›
‹kind a = Q:r↪⇘p⇙fs› ‹targetnode a ≠ m›
obtain ns where "CFG_node (targetnode a) cd-ns→⇩d* CFG_node m"
and "ns ≠ []"
and "∀n'' ∈ set ns. parent_node n'' ∈ set(sourcenodes as'')"
by(fastforce elim!:in_proc_cdep_SDG_path)
then obtain n' where "n' ⟶⇘cd⇙ CFG_node m"
and "parent_node n' ∈ set(sourcenodes as'')"
by -(erule cdep_SDG_path.cases,auto)
from ‹(parent_node n') ∈ set(sourcenodes as'')› obtain ms ms'
where "sourcenodes as'' = ms@(parent_node n')#ms'"
by(fastforce dest:split_list simp:sourcenodes_def)
then obtain xs a' ys where "ms = sourcenodes xs"
and "ms' = sourcenodes ys" and "as'' = xs@a'#ys"
and "parent_node n' = sourcenode a'"
by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
from ‹(_Entry_) -as→⇩√* m› ‹as = as'@a#as''› ‹as'' = xs@a'#ys›
have "(_Entry_) -(as'@a#xs)@a'#ys→⇩√* m" by simp
hence "(_Entry_) -as'@a#xs→⇩√* sourcenode a'"
and "valid_edge a'" by(auto intro:vp_split)
from ‹as = as'@a#as''› ‹as'' = xs@a'#ys›
have "length (as'@a#xs) < length as" by simp
from ‹valid_edge a'› have "valid_node (sourcenode a')" by simp
hence "inner_node (sourcenode a')"
proof(cases "sourcenode a'" rule:valid_node_cases)
case Entry
with ‹(_Entry_) -as'@a#xs→⇩√* sourcenode a'›
have "(_Entry_) -as'@a#xs→* (_Entry_)" by(fastforce simp:vp_def)
hence False by fastforce
thus ?thesis by simp
next
case Exit
with ‹valid_edge a'› have False by -(erule Exit_source)
thus ?thesis by simp
next
case inner
thus ?thesis by simp
qed
from ‹valid_edge a'› have "valid_SDG_node (CFG_node (sourcenode a'))"
by simp
from ‹∀a' ∈ set as. intra_kind(kind a') ∨ (∃Q r p fs. kind a' = Q:r↪⇘p⇙fs)›
‹as = as'@a#as''› ‹as'' = xs@a'#ys›
have "∀a' ∈ set (as'@a#xs).
intra_kind(kind a') ∨ (∃Q r p fs. kind a' = Q:r↪⇘p⇙fs)"
by auto
with IH ‹length (as'@a#xs) < length as›
‹(_Entry_) -as'@a#xs→⇩√* sourcenode a'›
‹valid_SDG_node (CFG_node (sourcenode a'))›
‹inner_node (sourcenode a')› ‹parent_node n' = sourcenode a'›
obtain ns where "CFG_node (_Entry_) cc-ns→⇩d* CFG_node (parent_node n')"
apply(erule_tac x="as'@a#xs" in allE) apply clarsimp
apply(erule_tac x="sourcenode a'" in allE) apply clarsimp
apply(erule_tac x="CFG_node (sourcenode a')" in allE) by clarsimp
from ‹n' ⟶⇘cd⇙ CFG_node m› have "valid_SDG_node n'"
by(rule SDG_edge_valid_SDG_node)
hence "n' = CFG_node (parent_node n') ∨ CFG_node (parent_node n') ⟶⇘cd⇙ n'"
by(rule valid_SDG_node_cases)
thus ?thesis
proof
assume "n' = CFG_node (parent_node n')"
with ‹CFG_node (_Entry_) cc-ns→⇩d* CFG_node (parent_node n')›
‹n' ⟶⇘cd⇙ CFG_node m› show ?thesis
by(fastforce intro:ccSp_Append_cdep)
next
assume "CFG_node (parent_node n') ⟶⇘cd⇙ n'"
with ‹CFG_node (_Entry_) cc-ns→⇩d* CFG_node (parent_node n')›
have "CFG_node (_Entry_) cc-ns@[CFG_node (parent_node n')]→⇩d* n'"
by(fastforce intro:ccSp_Append_cdep)
with ‹n' ⟶⇘cd⇙ CFG_node m› show ?thesis
by(fastforce intro:ccSp_Append_cdep)
qed
qed
then obtain ns where "CFG_node (_Entry_) cc-ns→⇩d* CFG_node m" by blast
show ?thesis
proof(cases "n = CFG_node m")
case True
with ‹CFG_node (_Entry_) cc-ns→⇩d* CFG_node m› show ?thesis by fastforce
next
case False
with ‹inner_node m› ‹valid_SDG_node n› ‹m = parent_node n›
have "CFG_node m ⟶⇘cd⇙ n"
by(fastforce intro:SDG_parent_cdep_edge inner_is_valid)
with ‹CFG_node (_Entry_) cc-ns→⇩d* CFG_node m› show ?thesis
by(fastforce dest:ccSp_Append_cdep)
qed
qed
qed
qed
qed
subsection ‹Same level paths in the SDG›
inductive matched :: "'node SDG_node ⇒ 'node SDG_node list ⇒ 'node SDG_node ⇒ bool"
where matched_Nil:
"valid_SDG_node n ⟹ matched n [] n"
| matched_Append_intra_SDG_path:
"⟦matched n ns n''; n'' i-ns'→⇩d* n'⟧ ⟹ matched n (ns@ns') n'"
| matched_bracket_call:
"⟦matched n⇩0 ns n⇩1; n⇩1 -p→⇘call⇙ n⇩2; matched n⇩2 ns' n⇩3;
(n⇩3 -p→⇘ret⇙ n⇩4 ∨ n⇩3 -p:V→⇘out⇙ n⇩4); valid_edge a; a' ∈ get_return_edges a;
sourcenode a = parent_node n⇩1; targetnode a = parent_node n⇩2;
sourcenode a' = parent_node n⇩3; targetnode a' = parent_node n⇩4⟧
⟹ matched n⇩0 (ns@n⇩1#ns'@[n⇩3]) n⇩4"
| matched_bracket_param:
"⟦matched n⇩0 ns n⇩1; n⇩1 -p:V→⇘in⇙ n⇩2; matched n⇩2 ns' n⇩3;
n⇩3 -p:V'→⇘out⇙ n⇩4; valid_edge a; a' ∈ get_return_edges a;
sourcenode a = parent_node n⇩1; targetnode a = parent_node n⇩2;
sourcenode a' = parent_node n⇩3; targetnode a' = parent_node n⇩4⟧
⟹ matched n⇩0 (ns@n⇩1#ns'@[n⇩3]) n⇩4"
lemma matched_Append:
"⟦matched n'' ns' n'; matched n ns n''⟧ ⟹ matched n (ns@ns') n'"
by(induct rule:matched.induct,
auto intro:matched.intros simp:append_assoc[THEN sym] simp del:append_assoc)
lemma intra_SDG_path_matched:
assumes "n i-ns→⇩d* n'" shows "matched n ns n'"
proof -
from ‹n i-ns→⇩d* n'› have "valid_SDG_node n"
by(rule intra_SDG_path_valid_SDG_node)
hence "matched n [] n" by(rule matched_Nil)
with ‹n i-ns→⇩d* n'› have "matched n ([]@ns) n'"
by -(rule matched_Append_intra_SDG_path)
thus ?thesis by simp
qed
lemma intra_proc_matched:
assumes "valid_edge a" and "kind a = Q:r↪⇘p⇙fs" and "a' ∈ get_return_edges a"
shows "matched (CFG_node (targetnode a)) [CFG_node (targetnode a)]
(CFG_node (sourcenode a'))"
proof -
from assms have "CFG_node (targetnode a) ⟶⇘cd⇙ CFG_node (sourcenode a')"
by(fastforce intro:SDG_proc_entry_exit_cdep)
with ‹valid_edge a›
have "CFG_node (targetnode a) i-[]@[CFG_node (targetnode a)]→⇩d*
CFG_node (sourcenode a')"
by(fastforce intro:intra_SDG_path.intros)
with ‹valid_edge a›
have "matched (CFG_node (targetnode a)) ([]@[CFG_node (targetnode a)])
(CFG_node (sourcenode a'))"
by(fastforce intro:matched.intros)
thus ?thesis by simp
qed
lemma matched_intra_CFG_path:
assumes "matched n ns n'"
obtains as where "parent_node n -as→⇩ι* parent_node n'"
proof(atomize_elim)
from ‹matched n ns n'› show "∃as. parent_node n -as→⇩ι* parent_node n'"
proof(induct rule:matched.induct)
case matched_Nil thus ?case
by(fastforce dest:empty_path valid_SDG_CFG_node simp:intra_path_def)
next
case (matched_Append_intra_SDG_path n ns n'' ns' n')
from ‹∃as. parent_node n -as→⇩ι* parent_node n''› obtain as
where "parent_node n -as→⇩ι* parent_node n''" by blast
from ‹n'' i-ns'→⇩d* n'› obtain as' where "parent_node n'' -as'→⇩ι* parent_node n'"
by(fastforce elim:intra_SDG_path_intra_CFG_path)
with ‹parent_node n -as→⇩ι* parent_node n''›
have "parent_node n -as@as'→⇩ι* parent_node n'"
by(rule intra_path_Append)
thus ?case by fastforce
next
case (matched_bracket_call n⇩0 ns n⇩1 p n⇩2 ns' n⇩3 n⇩4 V a a')
from ‹valid_edge a› ‹a' ∈ get_return_edges a› ‹sourcenode a = parent_node n⇩1›
‹targetnode a' = parent_node n⇩4›
obtain a'' where "valid_edge a''" and "sourcenode a'' = parent_node n⇩1"
and "targetnode a'' = parent_node n⇩4" and "kind a'' = (λcf. False)⇩√"
by(fastforce dest:call_return_node_edge)
hence "parent_node n⇩1 -[a'']→* parent_node n⇩4" by(fastforce dest:path_edge)
moreover
from ‹kind a'' = (λcf. False)⇩√› have "∀a ∈ set [a'']. intra_kind(kind a)"
by(fastforce simp:intra_kind_def)
ultimately have "parent_node n⇩1 -[a'']→⇩ι* parent_node n⇩4"
by(auto simp:intra_path_def)
with ‹∃as. parent_node n⇩0 -as→⇩ι* parent_node n⇩1› show ?case
by(fastforce intro:intra_path_Append)
next
case (matched_bracket_param n⇩0 ns n⇩1 p V n⇩2 ns' n⇩3 V' n⇩4 a a')
from ‹valid_edge a› ‹a' ∈ get_return_edges a› ‹sourcenode a = parent_node n⇩1›
‹targetnode a' = parent_node n⇩4›
obtain a'' where "valid_edge a''" and "sourcenode a'' = parent_node n⇩1"
and "targetnode a'' = parent_node n⇩4" and "kind a'' = (λcf. False)⇩√"
by(fastforce dest:call_return_node_edge)
hence "parent_node n⇩1 -[a'']→* parent_node n⇩4" by(fastforce dest:path_edge)
moreover
from ‹kind a'' = (λcf. False)⇩√› have "∀a ∈ set [a'']. intra_kind(kind a)"
by(fastforce simp:intra_kind_def)
ultimately have "parent_node n⇩1 -[a'']→⇩ι* parent_node n⇩4"
by(auto simp:intra_path_def)
with ‹∃as. parent_node n⇩0 -as→⇩ι* parent_node n⇩1› show ?case
by(fastforce intro:intra_path_Append)
qed
qed
lemma matched_same_level_CFG_path:
assumes "matched n ns n'"
obtains as where "parent_node n -as→⇘sl⇙* parent_node n'"
proof(atomize_elim)
from ‹matched n ns n'›
show "∃as. parent_node n -as→⇘sl⇙* parent_node n'"
proof(induct rule:matched.induct)
case matched_Nil thus ?case
by(fastforce dest:empty_path valid_SDG_CFG_node simp:slp_def same_level_path_def)
next
case (matched_Append_intra_SDG_path n ns n'' ns' n')
from ‹∃as. parent_node n -as→⇘sl⇙* parent_node n''›
obtain as where "parent_node n -as→⇘sl⇙* parent_node n''" by blast
from ‹n'' i-ns'→⇩d* n'› obtain as' where "parent_node n'' -as'→⇩ι* parent_node n'"
by(erule intra_SDG_path_intra_CFG_path)
from ‹parent_node n'' -as'→⇩ι* parent_node n'›
have "parent_node n'' -as'→⇘sl⇙* parent_node n'" by(rule intra_path_slp)
with ‹parent_node n -as→⇘sl⇙* parent_node n''›
have "parent_node n -as@as'→⇘sl⇙* parent_node n'"
by(rule slp_Append)
thus ?case by fastforce
next
case (matched_bracket_call n⇩0 ns n⇩1 p n⇩2 ns' n⇩3 n⇩4 V a a')
from ‹valid_edge a› ‹a' ∈ get_return_edges a›
obtain Q r p' fs where "kind a = Q:r↪⇘p'⇙fs"
by(fastforce dest!:only_call_get_return_edges)
from ‹∃as. parent_node n⇩0 -as→⇘sl⇙* parent_node n⇩1›
obtain as where "parent_node n⇩0 -as→⇘sl⇙* parent_node n⇩1" by blast
from ‹∃as. parent_node n⇩2 -as→⇘sl⇙* parent_node n⇩3›
obtain as' where "parent_node n⇩2 -as'→⇘sl⇙* parent_node n⇩3" by blast
from ‹valid_edge a› ‹a' ∈ get_return_edges a› ‹kind a = Q:r↪⇘p'⇙fs›
obtain Q' f' where "kind a' = Q'↩⇘p'⇙f'" by(fastforce dest!:call_return_edges)
from ‹valid_edge a› ‹a' ∈ get_return_edges a› have "valid_edge a'"
by(rule get_return_edges_valid)
from ‹parent_node n⇩2 -as'→⇘sl⇙* parent_node n⇩3› have "same_level_path as'"
by(simp add:slp_def)
hence "same_level_path_aux ([]@[a]) as'"
by(fastforce intro:same_level_path_aux_callstack_Append simp:same_level_path_def)
from ‹same_level_path as'› have "upd_cs ([]@[a]) as' = ([]@[a])"
by(fastforce intro:same_level_path_upd_cs_callstack_Append
simp:same_level_path_def)
with ‹same_level_path_aux ([]@[a]) as'› ‹a' ∈ get_return_edges a›
‹kind a = Q:r↪⇘p'⇙fs› ‹kind a' = Q'↩⇘p'⇙f'›
have "same_level_path (a#as'@[a'])"
by(fastforce intro:same_level_path_aux_Append upd_cs_Append
simp:same_level_path_def)
from ‹valid_edge a'› ‹sourcenode a' = parent_node n⇩3›
‹targetnode a' = parent_node n⇩4›
have "parent_node n⇩3 -[a']→* parent_node n⇩4" by(fastforce dest:path_edge)
with ‹parent_node n⇩2 -as'→⇘sl⇙* parent_node n⇩3›
have "parent_node n⇩2 -as'@[a']→* parent_node n⇩4"
by(fastforce intro:path_Append simp:slp_def)
with ‹valid_edge a› ‹sourcenode a = parent_node n⇩1›
‹targetnode a = parent_node n⇩2›
have "parent_node n⇩1 -a#as'@[a']→* parent_node n⇩4" by -(rule Cons_path)
with ‹same_level_path (a#as'@[a'])›
have "parent_node n⇩1 -a#as'@[a']→⇘sl⇙* parent_node n⇩4" by(simp add:slp_def)
with ‹parent_node n⇩0 -as→⇘sl⇙* parent_node n⇩1›
have "parent_node n⇩0 -as@a#as'@[a']→⇘sl⇙* parent_node n⇩4" by(rule slp_Append)
with ‹sourcenode a = parent_node n⇩1› ‹sourcenode a' = parent_node n⇩3›
show ?case by fastforce
next
case (matched_bracket_param n⇩0 ns n⇩1 p V n⇩2 ns' n⇩3 V' n⇩4 a a')
from ‹valid_edge a› ‹a' ∈ get_return_edges a›
obtain Q r p' fs where "kind a = Q:r↪⇘p'⇙fs"
by(fastforce dest!:only_call_get_return_edges)
from ‹∃as. parent_node n⇩0 -as→⇘sl⇙* parent_node n⇩1›
obtain as where "parent_node n⇩0 -as→⇘sl⇙* parent_node n⇩1" by blast
from ‹∃as. parent_node n⇩2 -as→⇘sl⇙* parent_node n⇩3›
obtain as' where "parent_node n⇩2 -as'→⇘sl⇙* parent_node n⇩3" by blast
from ‹valid_edge a› ‹a' ∈ get_return_edges a› ‹kind a = Q:r↪⇘p'⇙fs›
obtain Q' f' where "kind a' = Q'↩⇘p'⇙f'" by(fastforce dest!:call_return_edges)
from ‹valid_edge a› ‹a' ∈ get_return_edges a› have "valid_edge a'"
by(rule get_return_edges_valid)
from ‹parent_node n⇩2 -as'→⇘sl⇙* parent_node n⇩3› have "same_level_path as'"
by(simp add:slp_def)
hence "same_level_path_aux ([]@[a]) as'"
by(fastforce intro:same_level_path_aux_callstack_Append simp:same_level_path_def)
from ‹same_level_path as'› have "upd_cs ([]@[a]) as' = ([]@[a])"
by(fastforce intro:same_level_path_upd_cs_callstack_Append
simp:same_level_path_def)
with ‹same_level_path_aux ([]@[a]) as'› ‹a' ∈ get_return_edges a›
‹kind a = Q:r↪⇘p'⇙fs› ‹kind a' = Q'↩⇘p'⇙f'›
have "same_level_path (a#as'@[a'])"
by(fastforce intro:same_level_path_aux_Append upd_cs_Append
simp:same_level_path_def)
from ‹valid_edge a'› ‹sourcenode a' = parent_node n⇩3›
‹targetnode a' = parent_node n⇩4›
have "parent_node n⇩3 -[a']→* parent_node n⇩4" by(fastforce dest:path_edge)
with ‹parent_node n⇩2 -as'→⇘sl⇙* parent_node n⇩3›
have "parent_node n⇩2 -as'@[a']→* parent_node n⇩4"
by(fastforce intro:path_Append simp:slp_def)
with ‹valid_edge a› ‹sourcenode a = parent_node n⇩1›
‹targetnode a = parent_node n⇩2›
have "parent_node n⇩1 -a#as'@[a']→* parent_node n⇩4" by -(rule Cons_path)
with ‹same_level_path (a#as'@[a'])›
have "parent_node n⇩1 -a#as'@[a']→⇘sl⇙* parent_node n⇩4" by(simp add:slp_def)
with ‹parent_node n⇩0 -as→⇘sl⇙* parent_node n⇩1›
have "parent_node n⇩0 -as@a#as'@[a']→⇘sl⇙* parent_node n⇩4" by(rule slp_Append)
with ‹sourcenode a = parent_node n⇩1› ‹sourcenode a' = parent_node n⇩3›
show ?case by fastforce
qed
qed
subsection ‹Realizable paths in the SDG›
inductive realizable ::
"'node SDG_node ⇒ 'node SDG_node list ⇒ 'node SDG_node ⇒ bool"
where realizable_matched:"matched n ns n' ⟹ realizable n ns n'"
| realizable_call:
"⟦realizable n⇩0 ns n⇩1; n⇩1 -p→⇘call⇙ n⇩2 ∨ n⇩1 -p:V→⇘in⇙ n⇩2; matched n⇩2 ns' n⇩3⟧
⟹ realizable n⇩0 (ns@n⇩1#ns') n⇩3"
lemma realizable_Append_matched:
"⟦realizable n ns n''; matched n'' ns' n'⟧ ⟹ realizable n (ns@ns') n'"
proof(induct rule:realizable.induct)
case (realizable_matched n ns n'')
from ‹matched n'' ns' n'› ‹matched n ns n''› have "matched n (ns@ns') n'"
by(rule matched_Append)
thus ?case by(rule realizable.realizable_matched)
next
case (realizable_call n⇩0 ns n⇩1 p n⇩2 V ns'' n⇩3)
from ‹matched n⇩3 ns' n'› ‹matched n⇩2 ns'' n⇩3› have "matched n⇩2 (ns''@ns') n'"
by(rule matched_Append)
with ‹realizable n⇩0 ns n⇩1› ‹n⇩1 -p→⇘call⇙ n⇩2 ∨ n⇩1 -p:V→⇘in⇙ n⇩2›
have "realizable n⇩0 (ns@n⇩1#(ns''@ns')) n'"
by(rule realizable.realizable_call)
thus ?case by simp
qed
lemma realizable_valid_CFG_path:
assumes "realizable n ns n'"
obtains as where "parent_node n -as→⇩√* parent_node n'"
proof(atomize_elim)
from ‹realizable n ns n'›
show "∃as. parent_node n -as→⇩√* parent_node n'"
proof(induct rule:realizable.induct)
case (realizable_matched n ns n')
from ‹matched n ns n'› obtain as where "parent_node n -as→⇘sl⇙* parent_node n'"
by(erule matched_same_level_CFG_path)
thus ?case by(fastforce intro:slp_vp)
next
case (realizable_call n⇩0 ns n⇩1 p n⇩2 V ns' n⇩3)
from ‹∃as. parent_node n⇩0 -as→⇩√* parent_node n⇩1›
obtain as where "parent_node n⇩0 -as→⇩√* parent_node n⇩1" by blast
from ‹matched n⇩2 ns' n⇩3› obtain as' where "parent_node n⇩2 -as'→⇘sl⇙* parent_node n⇩3"
by(erule matched_same_level_CFG_path)
from ‹n⇩1 -p→⇘call⇙ n⇩2 ∨ n⇩1 -p:V→⇘in⇙ n⇩2›
obtain a Q r fs where "valid_edge a"
and "sourcenode a = parent_node n⇩1" and "targetnode a = parent_node n⇩2"
and "kind a = Q:r↪⇘p⇙fs" by(fastforce elim:SDG_edge.cases)+
hence "parent_node n⇩1 -[a]→* parent_node n⇩2"
by(fastforce dest:path_edge)
from ‹parent_node n⇩0 -as→⇩√* parent_node n⇩1›
have "parent_node n⇩0 -as→* parent_node n⇩1" and "valid_path as"
by(simp_all add:vp_def)
with ‹kind a = Q:r↪⇘p⇙fs› have "valid_path (as@[a])"
by(fastforce elim:valid_path_aux_Append simp:valid_path_def)
moreover
from ‹parent_node n⇩0 -as→* parent_node n⇩1› ‹parent_node n⇩1 -[a]→* parent_node n⇩2›
have "parent_node n⇩0 -as@[a]→* parent_node n⇩2" by(rule path_Append)
ultimately have "parent_node n⇩0 -as@[a]→⇩√* parent_node n⇩2" by(simp add:vp_def)
with ‹parent_node n⇩2 -as'→⇘sl⇙* parent_node n⇩3›
have "parent_node n⇩0 -(as@[a])@as'→⇩√* parent_node n⇩3" by -(rule vp_slp_Append)
with ‹sourcenode a = parent_node n⇩1› show ?case by fastforce
qed
qed
lemma cdep_SDG_path_realizable:
"n cc-ns→⇩d* n' ⟹ realizable n ns n'"
proof(induct rule:call_cdep_SDG_path.induct)
case (ccSp_Nil n)
from ‹valid_SDG_node n› show ?case
by(fastforce intro:realizable_matched matched_Nil)
next
case (ccSp_Append_cdep n ns n'' n')
from ‹n'' ⟶⇘cd⇙ n'› have "valid_SDG_node n''" by(rule SDG_edge_valid_SDG_node)
hence "matched n'' [] n''" by(rule matched_Nil)
from ‹n'' ⟶⇘cd⇙ n'› ‹valid_SDG_node n''›
have "n'' i-[]@[n'']→⇩d* n'"
by(fastforce intro:iSp_Append_cdep iSp_Nil)
with ‹matched n'' [] n''› have "matched n'' ([]@[n'']) n'"
by(fastforce intro:matched_Append_intra_SDG_path)
with ‹realizable n ns n''› show ?case
by(fastforce intro:realizable_Append_matched)
next
case (ccSp_Append_call n ns n'' p n')
from ‹n'' -p→⇘call⇙ n'› have "valid_SDG_node n'" by(rule SDG_edge_valid_SDG_node)
hence "matched n' [] n'" by(rule matched_Nil)
with ‹realizable n ns n''› ‹n'' -p→⇘call⇙ n'›
show ?case by(fastforce intro:realizable_call)
qed
subsection ‹SDG with summary edges›
inductive sum_cdep_edge :: "'node SDG_node ⇒ 'node SDG_node ⇒ bool"
("_ s⟶⇘cd⇙ _" [51,0] 80)
and sum_ddep_edge :: "'node SDG_node ⇒ 'var ⇒ 'node SDG_node ⇒ bool"
("_ s-_→⇩d⇩d _" [51,0,0] 80)
and sum_call_edge :: "'node SDG_node ⇒ 'pname ⇒ 'node SDG_node ⇒ bool"
("_ s-_→⇘call⇙ _" [51,0,0] 80)
and sum_return_edge :: "'node SDG_node ⇒ 'pname ⇒ 'node SDG_node ⇒ bool"
("_ s-_→⇘ret⇙ _" [51,0,0] 80)
and sum_param_in_edge :: "'node SDG_node ⇒ 'pname ⇒ 'var ⇒ 'node SDG_node ⇒ bool"
("_ s-_:_→⇘in⇙ _" [51,0,0,0] 80)
and sum_param_out_edge :: "'node SDG_node ⇒ 'pname ⇒ 'var ⇒ 'node SDG_node ⇒ bool"
("_ s-_:_→⇘out⇙ _" [51,0,0,0] 80)
and sum_summary_edge :: "'node SDG_node ⇒ 'pname ⇒ 'node SDG_node ⇒ bool"
("_ s-_→⇘sum⇙ _" [51,0] 80)
and sum_SDG_edge :: "'node SDG_node ⇒ 'var option ⇒
('pname × bool) option ⇒ bool ⇒ 'node SDG_node ⇒ bool"
where
"n s⟶⇘cd⇙ n' == sum_SDG_edge n None None False n'"
| "n s-V→⇩d⇩d n' == sum_SDG_edge n (Some V) None False n'"
| "n s-p→⇘call⇙ n' == sum_SDG_edge n None (Some(p,True)) False n'"
| "n s-p→⇘ret⇙ n' == sum_SDG_edge n None (Some(p,False)) False n'"
| "n s-p:V→⇘in⇙ n' == sum_SDG_edge n (Some V) (Some(p,True)) False n'"
| "n s-p:V→⇘out⇙ n' == sum_SDG_edge n (Some V) (Some(p,False)) False n'"
| "n s-p→⇘sum⇙ n' == sum_SDG_edge n None (Some(p,True)) True n'"
| sum_SDG_cdep_edge:
"⟦n = CFG_node m; n' = CFG_node m'; m controls m'⟧ ⟹ n s⟶⇘cd⇙ n'"
| sum_SDG_proc_entry_exit_cdep:
"⟦valid_edge a; kind a = Q:r↪⇘p⇙fs; n = CFG_node (targetnode a);
a' ∈ get_return_edges a; n' = CFG_node (sourcenode a')⟧ ⟹ n s⟶⇘cd⇙ n'"
| sum_SDG_parent_cdep_edge:
"⟦valid_SDG_node n'; m = parent_node n'; n = CFG_node m; n ≠ n'⟧
⟹ n s⟶⇘cd⇙ n'"
| sum_SDG_ddep_edge:"n influences V in n' ⟹ n s-V→⇩d⇩d n'"
| sum_SDG_call_edge:
"⟦valid_edge a; kind a = Q:r↪⇘p⇙fs; n = CFG_node (sourcenode a);
n' = CFG_node (targetnode a)⟧ ⟹ n s-p→⇘call⇙ n'"
| sum_SDG_return_edge:
"⟦valid_edge a; kind a = Q↩⇘p⇙fs; n = CFG_node (sourcenode a);
n' = CFG_node (targetnode a)⟧ ⟹ n s-p→⇘ret⇙ n'"
| sum_SDG_param_in_edge:
"⟦valid_edge a; kind a = Q:r↪⇘p⇙fs; (p,ins,outs) ∈ set procs; V = ins!x;
x < length ins; n = Actual_in (sourcenode a,x); n' = Formal_in (targetnode a,x)⟧
⟹ n s-p:V→⇘in⇙ n'"
| sum_SDG_param_out_edge:
"⟦valid_edge a; kind a = Q↩⇘p⇙f; (p,ins,outs) ∈ set procs; V = outs!x;
x < length outs; n = Formal_out (sourcenode a,x);
n' = Actual_out (targetnode a,x)⟧
⟹ n s-p:V→⇘out⇙ n'"
| sum_SDG_call_summary_edge:
"⟦valid_edge a; kind a = Q:r↪⇘p⇙fs; a' ∈ get_return_edges a;
n = CFG_node (sourcenode a); n' = CFG_node (targetnode a')⟧
⟹ n s-p→⇘sum⇙ n'"
| sum_SDG_param_summary_edge:
"⟦valid_edge a; kind a = Q:r↪⇘p⇙fs; a' ∈ get_return_edges a;
matched (Formal_in (targetnode a,x)) ns (Formal_out (sourcenode a',x'));
n = Actual_in (sourcenode a,x); n' = Actual_out (targetnode a',x');
(p,ins,outs) ∈ set procs; x < length ins; x' < length outs⟧
⟹ n s-p→⇘sum⇙ n'"
lemma sum_edge_cases:
"⟦n s-p→⇘sum⇙ n';
⋀a Q r fs a'. ⟦valid_edge a; kind a = Q:r↪⇘p⇙fs; a' ∈ get_return_edges a;
n = CFG_node (sourcenode a); n' = CFG_node (targetnode a')⟧ ⟹ P;
⋀a Q p r fs a' ns x x' ins outs.
⟦valid_edge a; kind a = Q:r↪⇘p⇙fs; a' ∈ get_return_edges a;
matched (Formal_in (targetnode a,x)) ns (Formal_out (sourcenode a',x'));
n = Actual_in (sourcenode a,x); n' = Actual_out (targetnode a',x');
(p,ins,outs) ∈ set procs; x < length ins; x' < length outs⟧ ⟹ P⟧
⟹ P"
by -(erule sum_SDG_edge.cases,auto)
lemma SDG_edge_sum_SDG_edge:
"SDG_edge n Vopt popt n' ⟹ sum_SDG_edge n Vopt popt False n'"
by(induct rule:SDG_edge.induct,auto intro:sum_SDG_edge.intros)
lemma sum_SDG_edge_SDG_edge:
"sum_SDG_edge n Vopt popt False n' ⟹ SDG_edge n Vopt popt n'"
by(induct n Vopt popt x≡"False" n' rule:sum_SDG_edge.induct,
auto intro:SDG_edge.intros)
lemma sum_SDG_edge_valid_SDG_node:
assumes "sum_SDG_edge n Vopt popt b n'"
shows "valid_SDG_node n" and "valid_SDG_node n'"
proof -
have "valid_SDG_node n ∧ valid_SDG_node n'"
proof(cases b)
case True
with ‹sum_SDG_edge n Vopt popt b n'› show ?thesis
proof(induct rule:sum_SDG_edge.induct)
case (sum_SDG_call_summary_edge a Q r p f a' n n')
from ‹valid_edge a› ‹n = CFG_node (sourcenode a)›
have "valid_SDG_node n" by fastforce
from ‹valid_edge a› ‹a' ∈ get_return_edges a› have "valid_edge a'"
by(rule get_return_edges_valid)
with ‹n' = CFG_node (targetnode a')› have "valid_SDG_node n'" by fastforce
with ‹valid_SDG_node n› show ?case by simp
next
case (sum_SDG_param_summary_edge a Q r p fs a' x ns x' n n' ins outs)
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹n = Actual_in (sourcenode a,x)›
‹(p,ins,outs) ∈ set procs› ‹x < length ins›
have "valid_SDG_node n" by fastforce
from ‹valid_edge a› ‹a' ∈ get_return_edges a› have "valid_edge a'"
by(rule get_return_edges_valid)
from ‹valid_edge a› ‹a' ∈ get_return_edges a› ‹kind a = Q:r↪⇘p⇙fs›
obtain Q' f' where "kind a' = Q'↩⇘p⇙f'" by(fastforce dest!:call_return_edges)
with ‹valid_edge a'› ‹n' = Actual_out (targetnode a',x')›
‹(p,ins,outs) ∈ set procs› ‹x' < length outs›
have "valid_SDG_node n'" by fastforce
with ‹valid_SDG_node n› show ?case by simp
qed simp_all
next
case False
with ‹sum_SDG_edge n Vopt popt b n'› have "SDG_edge n Vopt popt n'"
by(fastforce intro:sum_SDG_edge_SDG_edge)
thus ?thesis by(fastforce intro:SDG_edge_valid_SDG_node)
qed
thus "valid_SDG_node n" and "valid_SDG_node n'" by simp_all
qed
lemma Exit_no_sum_SDG_edge_source:
assumes "sum_SDG_edge (CFG_node (_Exit_)) Vopt popt b n'" shows "False"
proof(cases b)
case True
with ‹sum_SDG_edge (CFG_node (_Exit_)) Vopt popt b n'› show ?thesis
proof(induct "CFG_node (_Exit_)" Vopt popt b n' rule:sum_SDG_edge.induct)
case (sum_SDG_call_summary_edge a Q r p f a' n')
from ‹CFG_node (_Exit_) = CFG_node (sourcenode a)›
have "sourcenode a = (_Exit_)" by simp
with ‹valid_edge a› show ?case by(rule Exit_source)
next
case (sum_SDG_param_summary_edge a Q r p f a' x ns x' n' ins outs)
thus ?case by simp
qed simp_all
next
case False
with ‹sum_SDG_edge (CFG_node (_Exit_)) Vopt popt b n'›
have "SDG_edge (CFG_node (_Exit_)) Vopt popt n'"
by(fastforce intro:sum_SDG_edge_SDG_edge)
thus ?thesis by(fastforce intro:Exit_no_SDG_edge_source)
qed
lemma Exit_no_sum_SDG_edge_target:
"sum_SDG_edge n Vopt popt b (CFG_node (_Exit_)) ⟹ False"
proof(induct "CFG_node (_Exit_)" rule:sum_SDG_edge.induct)
case (sum_SDG_cdep_edge n m m')
from ‹m controls m'› ‹CFG_node (_Exit_) = CFG_node m'›
have "m controls (_Exit_)" by simp
hence False by(fastforce dest:Exit_not_control_dependent)
thus ?case by simp
next
case (sum_SDG_proc_entry_exit_cdep a Q r p f n a')
from ‹valid_edge a› ‹a' ∈ get_return_edges a› have "valid_edge a'"
by(rule get_return_edges_valid)
moreover
from ‹CFG_node (_Exit_) = CFG_node (sourcenode a')›
have "sourcenode a' = (_Exit_)" by simp
ultimately have False by(rule Exit_source)
thus ?case by simp
next
case (sum_SDG_ddep_edge n V) thus ?case
by(fastforce elim:SDG_Use.cases simp:data_dependence_def)
next
case (sum_SDG_call_edge a Q r p fs n)
from ‹CFG_node (_Exit_) = CFG_node (targetnode a)›
have "targetnode a = (_Exit_)" by simp
with ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› have "get_proc (_Exit_) = p"
by(fastforce intro:get_proc_call)
hence "p = Main" by(simp add:get_proc_Exit)
with ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› have False
by(fastforce intro:Main_no_call_target)
thus ?case by simp
next
case (sum_SDG_return_edge a Q p f n)
from ‹CFG_node (_Exit_) = CFG_node (targetnode a)›
have "targetnode a = (_Exit_)" by simp
with ‹valid_edge a› ‹kind a = Q↩⇘p⇙f› have False by(rule Exit_no_return_target)
thus ?case by simp
next
case (sum_SDG_call_summary_edge a Q r p fs a' n)
from ‹valid_edge a› ‹a' ∈ get_return_edges a› have "valid_edge a'"
by(rule get_return_edges_valid)
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹a' ∈ get_return_edges a›
obtain Q' f' where "kind a' = Q'↩⇘p⇙f'" by(fastforce dest!:call_return_edges)
from ‹CFG_node (_Exit_) = CFG_node (targetnode a')›
have "targetnode a' = (_Exit_)" by simp
with ‹valid_edge a'› ‹kind a' = Q'↩⇘p⇙f'› have False by(rule Exit_no_return_target)
thus ?case by simp
qed simp+
lemma sum_SDG_summary_edge_matched:
assumes "n s-p→⇘sum⇙ n'"
obtains ns where "matched n ns n'" and "n ∈ set ns"
and "get_proc (parent_node(last ns)) = p"
proof(atomize_elim)
from ‹n s-p→⇘sum⇙ n'›
show "∃ns. matched n ns n' ∧ n ∈ set ns ∧ get_proc (parent_node(last ns)) = p"
proof(induct n "None::'var option" "Some(p,True)" "True" n'
rule:sum_SDG_edge.induct)
case (sum_SDG_call_summary_edge a Q r fs a' n n')
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹n = CFG_node (sourcenode a)›
have "n -p→⇘call⇙ CFG_node (targetnode a)" by(fastforce intro:SDG_call_edge)
hence "valid_SDG_node n" by(rule SDG_edge_valid_SDG_node)
hence "matched n [] n" by(rule matched_Nil)
from ‹valid_edge a› ‹a' ∈ get_return_edges a› have "valid_edge a'"
by(rule get_return_edges_valid)
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹a' ∈ get_return_edges a›
have matched:"matched (CFG_node (targetnode a)) [CFG_node (targetnode a)]
(CFG_node (sourcenode a'))" by(rule intra_proc_matched)
from ‹valid_edge a› ‹a' ∈ get_return_edges a› ‹kind a = Q:r↪⇘p⇙fs›
obtain Q' f' where "kind a' = Q'↩⇘p⇙f'" by(fastforce dest!:call_return_edges)
with ‹valid_edge a'› have "get_proc (sourcenode a') = p" by(rule get_proc_return)
from ‹valid_edge a'› ‹kind a' = Q'↩⇘p⇙f'› ‹n' = CFG_node (targetnode a')›
have "CFG_node (sourcenode a') -p→⇘ret⇙ n'" by(fastforce intro:SDG_return_edge)
from ‹matched n [] n› ‹n -p→⇘call⇙ CFG_node (targetnode a)› matched
‹CFG_node (sourcenode a') -p→⇘ret⇙ n'› ‹a' ∈ get_return_edges a›
‹n = CFG_node (sourcenode a)› ‹n' = CFG_node (targetnode a')› ‹valid_edge a›
have "matched n ([]@n#[CFG_node (targetnode a)]@[CFG_node (sourcenode a')]) n'"
by(fastforce intro:matched_bracket_call)
with ‹get_proc (sourcenode a') = p› show ?case by auto
next
case (sum_SDG_param_summary_edge a Q r fs a' x ns x' n n' ins outs)
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹(p,ins,outs) ∈ set procs›
‹x < length ins› ‹n = Actual_in (sourcenode a,x)›
have "n -p:ins!x→⇘in⇙ Formal_in (targetnode a,x)"
by(fastforce intro:SDG_param_in_edge)
hence "valid_SDG_node n" by(rule SDG_edge_valid_SDG_node)
hence "matched n [] n" by(rule matched_Nil)
from ‹valid_edge a› ‹a' ∈ get_return_edges a› have "valid_edge a'"
by(rule get_return_edges_valid)
from ‹valid_edge a› ‹a' ∈ get_return_edges a› ‹kind a = Q:r↪⇘p⇙fs›
obtain Q' f' where "kind a' = Q'↩⇘p⇙f'" by(fastforce dest!:call_return_edges)
with ‹valid_edge a'› have "get_proc (sourcenode a') = p" by(rule get_proc_return)
from ‹valid_edge a'› ‹kind a' = Q'↩⇘p⇙f'› ‹(p,ins,outs) ∈ set procs›
‹x' < length outs› ‹n' = Actual_out (targetnode a',x')›
have "Formal_out (sourcenode a',x') -p:outs!x'→⇘out⇙ n'"
by(fastforce intro:SDG_param_out_edge)
from ‹matched n [] n› ‹n -p:ins!x→⇘in⇙ Formal_in (targetnode a,x)›
‹matched (Formal_in (targetnode a,x)) ns (Formal_out (sourcenode a',x'))›
‹Formal_out (sourcenode a',x') -p:outs!x'→⇘out⇙ n'›
‹a' ∈ get_return_edges a› ‹n = Actual_in (sourcenode a,x)›
‹n' = Actual_out (targetnode a',x')› ‹valid_edge a›
have "matched n ([]@n#ns@[Formal_out (sourcenode a',x')]) n'"
by(fastforce intro:matched_bracket_param)
with ‹get_proc (sourcenode a') = p› show ?case by auto
qed simp_all
qed
lemma return_edge_determines_call_and_sum_edge:
assumes "valid_edge a" and "kind a = Q↩⇘p⇙f"
obtains a' Q' r' fs' where "a ∈ get_return_edges a'" and "valid_edge a'"
and "kind a' = Q':r'↪⇘p⇙fs'"
and "CFG_node (sourcenode a') s-p→⇘sum⇙ CFG_node (targetnode a)"
proof(atomize_elim)
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f›
have "CFG_node (sourcenode a) s-p→⇘ret⇙ CFG_node (targetnode a)"
by(fastforce intro:sum_SDG_return_edge)
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f›
obtain a' Q' r' fs' where "valid_edge a'" and "kind a' = Q':r'↪⇘p⇙fs'"
and "a ∈ get_return_edges a'" by(blast dest:return_needs_call)
hence "CFG_node (sourcenode a') s-p→⇘call⇙ CFG_node (targetnode a')"
by(fastforce intro:sum_SDG_call_edge)
from ‹valid_edge a'› ‹kind a' = Q':r'↪⇘p⇙fs'› ‹valid_edge a› ‹a ∈ get_return_edges a'›
have "CFG_node (targetnode a') ⟶⇘cd⇙ CFG_node (sourcenode a)"
by(fastforce intro!:SDG_proc_entry_exit_cdep)
hence "valid_SDG_node (CFG_node (targetnode a'))"
by(rule SDG_edge_valid_SDG_node)
with ‹CFG_node (targetnode a') ⟶⇘cd⇙ CFG_node (sourcenode a)›
have "CFG_node (targetnode a') i-[]@[CFG_node (targetnode a')]→⇩d*
CFG_node (sourcenode a)"
by(fastforce intro:iSp_Append_cdep iSp_Nil)
from ‹valid_SDG_node (CFG_node (targetnode a'))›
have "matched (CFG_node (targetnode a')) [] (CFG_node (targetnode a'))"
by(rule matched_Nil)
with ‹CFG_node (targetnode a') i-[]@[CFG_node (targetnode a')]→⇩d*
CFG_node (sourcenode a)›
have "matched (CFG_node (targetnode a')) ([]@[CFG_node (targetnode a')])
(CFG_node (sourcenode a))"
by(fastforce intro:matched_Append_intra_SDG_path)
with ‹valid_edge a'› ‹kind a' = Q':r'↪⇘p⇙fs'› ‹valid_edge a› ‹kind a = Q↩⇘p⇙f›
‹a ∈ get_return_edges a'›
have "CFG_node (sourcenode a') s-p→⇘sum⇙ CFG_node (targetnode a)"
by(fastforce intro!:sum_SDG_call_summary_edge)
with ‹a ∈ get_return_edges a'› ‹valid_edge a'› ‹kind a' = Q':r'↪⇘p⇙fs'›
show "∃a' Q' r' fs'. a ∈ get_return_edges a' ∧ valid_edge a' ∧
kind a' = Q':r'↪⇘p⇙fs' ∧ CFG_node (sourcenode a') s-p→⇘sum⇙ CFG_node (targetnode a)"
by fastforce
qed
subsection ‹Paths consisting of intraprocedural and summary edges in the SDG›
inductive intra_sum_SDG_path ::
"'node SDG_node ⇒ 'node SDG_node list ⇒ 'node SDG_node ⇒ bool"
("_ is-_→⇩d* _" [51,0,0] 80)
where isSp_Nil:
"valid_SDG_node n ⟹ n is-[]→⇩d* n"
| isSp_Append_cdep:
"⟦n is-ns→⇩d* n''; n'' s⟶⇘cd⇙ n'⟧ ⟹ n is-ns@[n'']→⇩d* n'"
| isSp_Append_ddep:
"⟦n is-ns→⇩d* n''; n'' s-V→⇩d⇩d n'; n'' ≠ n'⟧ ⟹ n is-ns@[n'']→⇩d* n'"
| isSp_Append_sum:
"⟦n is-ns→⇩d* n''; n'' s-p→⇘sum⇙ n'⟧ ⟹ n is-ns@[n'']→⇩d* n'"
lemma is_SDG_path_Append:
"⟦n'' is-ns'→⇩d* n'; n is-ns→⇩d* n''⟧ ⟹ n is-ns@ns'→⇩d* n'"
by(induct rule:intra_sum_SDG_path.induct,
auto intro:intra_sum_SDG_path.intros simp:append_assoc[THEN sym]
simp del:append_assoc)
lemma is_SDG_path_valid_SDG_node:
assumes "n is-ns→⇩d* n'" shows "valid_SDG_node n" and "valid_SDG_node n'"
using ‹n is-ns→⇩d* n'›
by(induct rule:intra_sum_SDG_path.induct,
auto intro:sum_SDG_edge_valid_SDG_node valid_SDG_CFG_node)
lemma intra_SDG_path_is_SDG_path:
"n i-ns→⇩d* n' ⟹ n is-ns→⇩d* n'"
by(induct rule:intra_SDG_path.induct,
auto intro:intra_sum_SDG_path.intros SDG_edge_sum_SDG_edge)
lemma is_SDG_path_hd:"⟦n is-ns→⇩d* n'; ns ≠ []⟧ ⟹ hd ns = n"
apply(induct rule:intra_sum_SDG_path.induct) apply clarsimp
by(case_tac ns,auto elim:intra_sum_SDG_path.cases)+
lemma intra_sum_SDG_path_rev_induct [consumes 1, case_names "isSp_Nil"
"isSp_Cons_cdep" "isSp_Cons_ddep" "isSp_Cons_sum"]:
assumes "n is-ns→⇩d* n'"
and refl:"⋀n. valid_SDG_node n ⟹ P n [] n"
and step_cdep:"⋀n ns n' n''. ⟦n s⟶⇘cd⇙ n''; n'' is-ns→⇩d* n'; P n'' ns n'⟧
⟹ P n (n#ns) n'"
and step_ddep:"⋀n ns n' V n''. ⟦n s-V→⇩d⇩d n''; n ≠ n''; n'' is-ns→⇩d* n';
P n'' ns n'⟧ ⟹ P n (n#ns) n'"
and step_sum:"⋀n ns n' p n''. ⟦n s-p→⇘sum⇙ n''; n'' is-ns→⇩d* n'; P n'' ns n'⟧
⟹ P n (n#ns) n'"
shows "P n ns n'"
using ‹n is-ns→⇩d* n'›
proof(induct ns arbitrary:n)
case Nil thus ?case by(fastforce elim:intra_sum_SDG_path.cases intro:refl)
next
case (Cons nx nsx)
note IH = ‹⋀n. n is-nsx→⇩d* n' ⟹ P n nsx n'›
from ‹n is-nx#nsx→⇩d* n'› have [simp]:"n = nx"
by(fastforce dest:is_SDG_path_hd)
from ‹n is-nx#nsx→⇩d* n'› have "((∃n''. n s⟶⇘cd⇙ n'' ∧ n'' is-nsx→⇩d* n') ∨
(∃n'' V. n s-V→⇩d⇩d n'' ∧ n ≠ n'' ∧ n'' is-nsx→⇩d* n')) ∨
(∃n'' p. n s-p→⇘sum⇙ n'' ∧ n'' is-nsx→⇩d* n')"
proof(induct nsx arbitrary:n' rule:rev_induct)
case Nil
from ‹n is-[nx]→⇩d* n'› have "n is-[]→⇩d* nx"
and disj:"nx s⟶⇘cd⇙ n' ∨ (∃V. nx s-V→⇩d⇩d n' ∧ nx ≠ n') ∨ (∃p. nx s-p→⇘sum⇙ n')"
by(induct n ns≡"[nx]" n' rule:intra_sum_SDG_path.induct,auto)
from ‹n is-[]→⇩d* nx› have [simp]:"n = nx"
by(fastforce elim:intra_sum_SDG_path.cases)
from disj have "valid_SDG_node n'" by(fastforce intro:sum_SDG_edge_valid_SDG_node)
hence "n' is-[]→⇩d* n'" by(rule isSp_Nil)
with disj show ?case by fastforce
next
case (snoc x xs)
note ‹⋀n'. n is-nx # xs→⇩d* n' ⟹
((∃n''. n s⟶⇘cd⇙ n'' ∧ n'' is-xs→⇩d* n') ∨
(∃n'' V. n s-V→⇩d⇩d n'' ∧ n ≠ n'' ∧ n'' is-xs→⇩d* n')) ∨
(∃n'' p. n s-p→⇘sum⇙ n'' ∧ n'' is-xs→⇩d* n')›
with ‹n is-nx#xs@[x]→⇩d* n'› show ?case
proof(induct n "nx#xs@[x]" n' rule:intra_sum_SDG_path.induct)
case (isSp_Append_cdep m ms m'' n')
note IH = ‹⋀n'. m is-nx # xs→⇩d* n' ⟹
((∃n''. m s⟶⇘cd⇙ n'' ∧ n'' is-xs→⇩d* n') ∨
(∃n'' V. m s-V→⇩d⇩d n'' ∧ m ≠ n'' ∧ n'' is-xs→⇩d* n')) ∨
(∃n'' p. m s-p→⇘sum⇙ n'' ∧ n'' is-xs→⇩d* n')›
from ‹ms @ [m''] = nx#xs@[x]› have [simp]:"ms = nx#xs"
and [simp]:"m'' = x" by simp_all
from ‹m is-ms→⇩d* m''› have "m is-nx#xs→⇩d* m''" by simp
from IH[OF this] obtain n'' where "n'' is-xs→⇩d* m''"
and "(m s⟶⇘cd⇙ n'' ∨ (∃V. m s-V→⇩d⇩d n'' ∧ m ≠ n'')) ∨ (∃p. m s-p→⇘sum⇙ n'')"
by fastforce
from ‹n'' is-xs→⇩d* m''› ‹m'' s⟶⇘cd⇙ n'›
have "n'' is-xs@[m'']→⇩d* n'" by(rule intra_sum_SDG_path.intros)
with ‹(m s⟶⇘cd⇙ n'' ∨ (∃V. m s-V→⇩d⇩d n'' ∧ m ≠ n'')) ∨ (∃p. m s-p→⇘sum⇙ n'')›
show ?case by fastforce
next
case (isSp_Append_ddep m ms m'' V n')
note IH = ‹⋀n'. m is-nx # xs→⇩d* n' ⟹
((∃n''. m s⟶⇘cd⇙ n'' ∧ n'' is-xs→⇩d* n') ∨
(∃n'' V. m s-V→⇩d⇩d n'' ∧ m ≠ n'' ∧ n'' is-xs→⇩d* n')) ∨
(∃n'' p. m s-p→⇘sum⇙ n'' ∧ n'' is-xs→⇩d* n')›
from ‹ms @ [m''] = nx#xs@[x]› have [simp]:"ms = nx#xs"
and [simp]:"m'' = x" by simp_all
from ‹m is-ms→⇩d* m''› have "m is-nx#xs→⇩d* m''" by simp
from IH[OF this] obtain n'' where "n'' is-xs→⇩d* m''"
and "(m s⟶⇘cd⇙ n'' ∨ (∃V. m s-V→⇩d⇩d n'' ∧ m ≠ n'')) ∨ (∃p. m s-p→⇘sum⇙ n'')"
by fastforce
from ‹n'' is-xs→⇩d* m''› ‹m'' s-V→⇩d⇩d n'› ‹m'' ≠ n'›
have "n'' is-xs@[m'']→⇩d* n'" by(rule intra_sum_SDG_path.intros)
with ‹(m s⟶⇘cd⇙ n'' ∨ (∃V. m s-V→⇩d⇩d n'' ∧ m ≠ n'')) ∨ (∃p. m s-p→⇘sum⇙ n'')›
show ?case by fastforce
next
case (isSp_Append_sum m ms m'' p n')
note IH = ‹⋀n'. m is-nx # xs→⇩d* n' ⟹
((∃n''. m s⟶⇘cd⇙ n'' ∧ n'' is-xs→⇩d* n') ∨
(∃n'' V. m s-V→⇩d⇩d n'' ∧ m ≠ n'' ∧ n'' is-xs→⇩d* n')) ∨
(∃n'' p. m s-p→⇘sum⇙ n'' ∧ n'' is-xs→⇩d* n')›
from ‹ms @ [m''] = nx#xs@[x]› have [simp]:"ms = nx#xs"
and [simp]:"m'' = x" by simp_all
from ‹m is-ms→⇩d* m''› have "m is-nx#xs→⇩d* m''" by simp
from IH[OF this] obtain n'' where "n'' is-xs→⇩d* m''"
and "(m s⟶⇘cd⇙ n'' ∨ (∃V. m s-V→⇩d⇩d n'' ∧ m ≠ n'')) ∨ (∃p. m s-p→⇘sum⇙ n'')"
by fastforce
from ‹n'' is-xs→⇩d* m''› ‹m'' s-p→⇘sum⇙ n'›
have "n'' is-xs@[m'']→⇩d* n'" by(rule intra_sum_SDG_path.intros)
with ‹(m s⟶⇘cd⇙ n'' ∨ (∃V. m s-V→⇩d⇩d n'' ∧ m ≠ n'')) ∨ (∃p. m s-p→⇘sum⇙ n'')›
show ?case by fastforce
qed
qed
thus ?case apply -
proof(erule disjE)+
assume "∃n''. n s⟶⇘cd⇙ n'' ∧ n'' is-nsx→⇩d* n'"
then obtain n'' where "n s⟶⇘cd⇙ n''" and "n'' is-nsx→⇩d* n'" by blast
from IH[OF ‹n'' is-nsx→⇩d* n'›] have "P n'' nsx n'" .
from step_cdep[OF ‹n s⟶⇘cd⇙ n''› ‹n'' is-nsx→⇩d* n'› this] show ?thesis by simp
next
assume "∃n'' V. n s-V→⇩d⇩d n'' ∧ n ≠ n'' ∧ n'' is-nsx→⇩d* n'"
then obtain n'' V where "n s-V→⇩d⇩d n''" and "n ≠ n''" and "n'' is-nsx→⇩d* n'"
by blast
from IH[OF ‹n'' is-nsx→⇩d* n'›] have "P n'' nsx n'" .
from step_ddep[OF ‹n s-V→⇩d⇩d n''› ‹n ≠ n''› ‹n'' is-nsx→⇩d* n'› this]
show ?thesis by simp
next
assume "∃n'' p. n s-p→⇘sum⇙ n'' ∧ n'' is-nsx→⇩d* n'"
then obtain n'' p where "n s-p→⇘sum⇙ n''" and "n'' is-nsx→⇩d* n'" by blast
from IH[OF ‹n'' is-nsx→⇩d* n'›] have "P n'' nsx n'" .
from step_sum[OF ‹n s-p→⇘sum⇙ n''› ‹n'' is-nsx→⇩d* n'› this] show ?thesis by simp
qed
qed
lemma is_SDG_path_CFG_path:
assumes "n is-ns→⇩d* n'"
obtains as where "parent_node n -as→⇩ι* parent_node n'"
proof(atomize_elim)
from ‹n is-ns→⇩d* n'›
show "∃as. parent_node n -as→⇩ι* parent_node n'"
proof(induct rule:intra_sum_SDG_path.induct)
case (isSp_Nil n)
from ‹valid_SDG_node n› have "valid_node (parent_node n)"
by(rule valid_SDG_CFG_node)
hence "parent_node n -[]→* parent_node n" by(rule empty_path)
thus ?case by(auto simp:intra_path_def)
next
case (isSp_Append_cdep n ns n'' n')
from ‹∃as. parent_node n -as→⇩ι* parent_node n''›
obtain as where "parent_node n -as→⇩ι* parent_node n''" by blast
from ‹n'' s⟶⇘cd⇙ n'› have "n'' ⟶⇘cd⇙ n'" by(rule sum_SDG_edge_SDG_edge)
thus ?case
proof(rule cdep_edge_cases)
assume "parent_node n'' controls parent_node n'"
then obtain as' where "parent_node n'' -as'→⇩ι* parent_node n'" and "as' ≠ []"
by(erule control_dependence_path)
with ‹parent_node n -as→⇩ι* parent_node n''›
have "parent_node n -as@as'→⇩ι* parent_node n'" by -(rule intra_path_Append)
thus ?thesis by blast
next
fix a Q r p fs a'
assume "valid_edge a" and "kind a = Q:r↪⇘p⇙fs" and "a' ∈ get_return_edges a"
and "parent_node n'' = targetnode a" and "parent_node n' = sourcenode a'"
then obtain a'' where "valid_edge a''" and "sourcenode a'' = targetnode a"
and "targetnode a'' = sourcenode a'" and "kind a'' = (λcf. False)⇩√"
by(auto dest:intra_proc_additional_edge)
hence "targetnode a -[a'']→⇩ι* sourcenode a'"
by(fastforce dest:path_edge simp:intra_path_def intra_kind_def)
with ‹parent_node n'' = targetnode a› ‹parent_node n' = sourcenode a'›
have "∃as'. parent_node n'' -as'→⇩ι* parent_node n' ∧ as' ≠ []" by fastforce
then obtain as' where "parent_node n'' -as'→⇩ι* parent_node n'" and "as' ≠ []"
by blast
with ‹parent_node n -as→⇩ι* parent_node n''›
have "parent_node n -as@as'→⇩ι* parent_node n'" by -(rule intra_path_Append)
thus ?thesis by blast
next
fix m assume "n'' = CFG_node m" and "m = parent_node n'"
with ‹parent_node n -as→⇩ι* parent_node n''› show ?thesis by fastforce
qed
next
case (isSp_Append_ddep n ns n'' V n')
from ‹∃as. parent_node n -as→⇩ι* parent_node n''›
obtain as where "parent_node n -as→⇩ι* parent_node n''" by blast
from ‹n'' s-V→⇩d⇩d n'› have "n'' influences V in n'"
by(fastforce elim:sum_SDG_edge.cases)
then obtain as' where "parent_node n'' -as'→⇩ι* parent_node n'"
by(auto simp:data_dependence_def)
with ‹parent_node n -as→⇩ι* parent_node n''›
have "parent_node n -as@as'→⇩ι* parent_node n'" by -(rule intra_path_Append)
thus ?case by blast
next
case (isSp_Append_sum n ns n'' p n')
from ‹∃as. parent_node n -as→⇩ι* parent_node n''›
obtain as where "parent_node n -as→⇩ι* parent_node n''" by blast
from ‹n'' s-p→⇘sum⇙ n'› have "∃as'. parent_node n'' -as'→⇩ι* parent_node n'"
proof(rule sum_edge_cases)
fix a Q fs a'
assume "valid_edge a" and "a' ∈ get_return_edges a"
and "n'' = CFG_node (sourcenode a)" and "n' = CFG_node (targetnode a')"
from ‹valid_edge a› ‹a' ∈ get_return_edges a›
obtain a'' where "sourcenode a -[a'']→⇩ι* targetnode a'"
apply - apply(drule call_return_node_edge)
apply(auto simp:intra_path_def) apply(drule path_edge)
by(auto simp:intra_kind_def)
with ‹n'' = CFG_node (sourcenode a)› ‹n' = CFG_node (targetnode a')›
show ?thesis by simp blast
next
fix a Q p fs a' ns x x' ins outs
assume "valid_edge a" and "a' ∈ get_return_edges a"
and "n'' = Actual_in (sourcenode a, x)"
and "n' = Actual_out (targetnode a', x')"
from ‹valid_edge a› ‹a' ∈ get_return_edges a›
obtain a'' where "sourcenode a -[a'']→⇩ι* targetnode a'"
apply - apply(drule call_return_node_edge)
apply(auto simp:intra_path_def) apply(drule path_edge)
by(auto simp:intra_kind_def)
with ‹n'' = Actual_in (sourcenode a, x)› ‹n' = Actual_out (targetnode a', x')›
show ?thesis by simp blast
qed
then obtain as' where "parent_node n'' -as'→⇩ι* parent_node n'" by blast
with ‹parent_node n -as→⇩ι* parent_node n''›
have "parent_node n -as@as'→⇩ι* parent_node n'" by -(rule intra_path_Append)
thus ?case by blast
qed
qed
lemma matched_is_SDG_path:
assumes "matched n ns n'" obtains ns' where "n is-ns'→⇩d* n'"
proof(atomize_elim)
from ‹matched n ns n'› show "∃ns'. n is-ns'→⇩d* n'"
proof(induct rule:matched.induct)
case matched_Nil thus ?case by(fastforce intro:isSp_Nil)
next
case matched_Append_intra_SDG_path thus ?case
by(fastforce intro:is_SDG_path_Append intra_SDG_path_is_SDG_path)
next
case (matched_bracket_call n⇩0 ns n⇩1 p n⇩2 ns' n⇩3 n⇩4 V a a')
from ‹∃ns'. n⇩0 is-ns'→⇩d* n⇩1› obtain nsx where "n⇩0 is-nsx→⇩d* n⇩1" by blast
from ‹n⇩1 -p→⇘call⇙ n⇩2› ‹sourcenode a = parent_node n⇩1› ‹targetnode a = parent_node n⇩2›
have "n⇩1 = CFG_node (sourcenode a)" and "n⇩2 = CFG_node (targetnode a)"
by(auto elim:SDG_edge.cases)
from ‹valid_edge a› ‹a' ∈ get_return_edges a›
obtain Q r p' fs where "kind a = Q:r↪⇘p'⇙fs"
by(fastforce dest!:only_call_get_return_edges)
with ‹n⇩1 -p→⇘call⇙ n⇩2› ‹valid_edge a›
‹n⇩1 = CFG_node (sourcenode a)› ‹n⇩2 = CFG_node (targetnode a)›
have [simp]:"p' = p" by -(erule SDG_edge.cases,(fastforce dest:edge_det)+)
from ‹valid_edge a› ‹a' ∈ get_return_edges a› have "valid_edge a'"
by(rule get_return_edges_valid)
from ‹n⇩3 -p→⇘ret⇙ n⇩4 ∨ n⇩3 -p:V→⇘out⇙ n⇩4› show ?case
proof
assume "n⇩3 -p→⇘ret⇙ n⇩4"
then obtain ax Q' f' where "valid_edge ax" and "kind ax = Q'↩⇘p⇙f'"
and "n⇩3 = CFG_node (sourcenode ax)" and "n⇩4 = CFG_node (targetnode ax)"
by(fastforce elim:SDG_edge.cases)
with ‹sourcenode a' = parent_node n⇩3› ‹targetnode a' = parent_node n⇩4›
‹valid_edge a'› have [simp]:"ax = a'" by(fastforce dest:edge_det)
from ‹valid_edge a› ‹kind a = Q:r↪⇘p'⇙fs› ‹valid_edge ax› ‹kind ax = Q'↩⇘p⇙f'›
‹a' ∈ get_return_edges a› ‹matched n⇩2 ns' n⇩3›
‹n⇩1 = CFG_node (sourcenode a)› ‹n⇩2 = CFG_node (targetnode a)›
‹n⇩3 = CFG_node (sourcenode ax)› ‹n⇩4 = CFG_node (targetnode ax)›
have "n⇩1 s-p→⇘sum⇙ n⇩4"
by(fastforce intro!:sum_SDG_call_summary_edge[of a _ _ _ _ ax])
with ‹n⇩0 is-nsx→⇩d* n⇩1› have "n⇩0 is-nsx@[n⇩1]→⇩d* n⇩4" by(rule isSp_Append_sum)
thus ?case by blast
next
assume "n⇩3 -p:V→⇘out⇙ n⇩4"
then obtain ax Q' f' x where "valid_edge ax" and "kind ax = Q'↩⇘p⇙f'"
and "n⇩3 = Formal_out (sourcenode ax,x)"
and "n⇩4 = Actual_out (targetnode ax,x)"
by(fastforce elim:SDG_edge.cases)
with ‹sourcenode a' = parent_node n⇩3› ‹targetnode a' = parent_node n⇩4›
‹valid_edge a'› have [simp]:"ax = a'" by(fastforce dest:edge_det)
from ‹valid_edge ax› ‹kind ax = Q'↩⇘p⇙f'› ‹n⇩3 = Formal_out (sourcenode ax,x)›
‹n⇩4 = Actual_out (targetnode ax,x)›
have "CFG_node (sourcenode a') -p→⇘ret⇙ CFG_node (targetnode a')"
by(fastforce intro:SDG_return_edge)
from ‹valid_edge a› ‹kind a = Q:r↪⇘p'⇙fs› ‹valid_edge a'›
‹a' ∈ get_return_edges a› ‹n⇩4 = Actual_out (targetnode ax,x)›
have "CFG_node (targetnode a) ⟶⇘cd⇙ CFG_node (sourcenode a')"
by(fastforce intro!:SDG_proc_entry_exit_cdep)
with ‹n⇩2 = CFG_node (targetnode a)›
have "matched n⇩2 ([]@([]@[n⇩2])) (CFG_node (sourcenode a'))"
by(fastforce intro:matched.intros intra_SDG_path.intros
SDG_edge_valid_SDG_node)
with ‹valid_edge a› ‹kind a = Q:r↪⇘p'⇙fs› ‹valid_edge a'› ‹kind ax = Q'↩⇘p⇙f'›
‹a' ∈ get_return_edges a› ‹n⇩1 = CFG_node (sourcenode a)›
‹n⇩2 = CFG_node (targetnode a)› ‹n⇩4 = Actual_out (targetnode ax,x)›
have "n⇩1 s-p→⇘sum⇙ CFG_node (targetnode a')"
by(fastforce intro!:sum_SDG_call_summary_edge[of a _ _ _ _ a'])
with ‹n⇩0 is-nsx→⇩d* n⇩1› have "n⇩0 is-nsx@[n⇩1]→⇩d* CFG_node (targetnode a')"
by(rule isSp_Append_sum)
from ‹n⇩4 = Actual_out (targetnode ax,x)› ‹n⇩3 -p:V→⇘out⇙ n⇩4›
have "CFG_node (targetnode a') s⟶⇘cd⇙ n⇩4"
by(fastforce intro:sum_SDG_parent_cdep_edge SDG_edge_valid_SDG_node)
with ‹n⇩0 is-nsx@[n⇩1]→⇩d* CFG_node (targetnode a')›
have "n⇩0 is-(nsx@[n⇩1])@[CFG_node (targetnode a')]→⇩d* n⇩4"
by(rule isSp_Append_cdep)
thus ?case by blast
qed
next
case (matched_bracket_param n⇩0 ns n⇩1 p V n⇩2 ns' n⇩3 V' n⇩4 a a')
from ‹∃ns'. n⇩0 is-ns'→⇩d* n⇩1› obtain nsx where "n⇩0 is-nsx→⇩d* n⇩1" by blast
from ‹n⇩1 -p:V→⇘in⇙ n⇩2› ‹sourcenode a = parent_node n⇩1›
‹targetnode a = parent_node n⇩2› obtain x ins outs
where "n⇩1 = Actual_in (sourcenode a,x)" and "n⇩2 = Formal_in (targetnode a,x)"
and "(p,ins,outs) ∈ set procs" and "V = ins!x" and "x < length ins"
by(fastforce elim:SDG_edge.cases)
from ‹valid_edge a› ‹a' ∈ get_return_edges a›
obtain Q r p' fs where "kind a = Q:r↪⇘p'⇙fs"
by(fastforce dest!:only_call_get_return_edges)
with ‹n⇩1 -p:V→⇘in⇙ n⇩2› ‹valid_edge a›
‹n⇩1 = Actual_in (sourcenode a,x)› ‹n⇩2 = Formal_in (targetnode a,x)›
have [simp]:"p' = p" by -(erule SDG_edge.cases,(fastforce dest:edge_det)+)
from ‹valid_edge a› ‹a' ∈ get_return_edges a› have "valid_edge a'"
by(rule get_return_edges_valid)
from ‹n⇩3 -p:V'→⇘out⇙ n⇩4› obtain ax Q' f' x' ins' outs' where "valid_edge ax"
and "kind ax = Q'↩⇘p⇙f'" and "n⇩3 = Formal_out (sourcenode ax,x')"
and "n⇩4 = Actual_out (targetnode ax,x')" and "(p,ins',outs') ∈ set procs"
and "V' = outs'!x'" and "x' < length outs'"
by(fastforce elim:SDG_edge.cases)
with ‹sourcenode a' = parent_node n⇩3› ‹targetnode a' = parent_node n⇩4›
‹valid_edge a'› have [simp]:"ax = a'" by(fastforce dest:edge_det)
from unique_callers ‹(p,ins,outs) ∈ set procs› ‹(p,ins',outs') ∈ set procs›
have [simp]:"ins = ins'" "outs = outs'"
by(auto dest:distinct_fst_isin_same_fst)
from ‹valid_edge a› ‹kind a = Q:r↪⇘p'⇙fs› ‹valid_edge a'› ‹kind ax = Q'↩⇘p⇙f'›
‹a' ∈ get_return_edges a› ‹matched n⇩2 ns' n⇩3› ‹n⇩1 = Actual_in (sourcenode a,x)›
‹n⇩2 = Formal_in (targetnode a,x)› ‹n⇩3 = Formal_out (sourcenode ax,x')›
‹n⇩4 = Actual_out (targetnode ax,x')› ‹(p,ins,outs) ∈ set procs›
‹x < length ins› ‹x' < length outs'› ‹V = ins!x› ‹V' = outs'!x'›
have "n⇩1 s-p→⇘sum⇙ n⇩4"
by(fastforce intro!:sum_SDG_param_summary_edge[of a _ _ _ _ a'])
with ‹n⇩0 is-nsx→⇩d* n⇩1› have "n⇩0 is-nsx@[n⇩1]→⇩d* n⇩4" by(rule isSp_Append_sum)
thus ?case by blast
qed
qed
lemma is_SDG_path_matched:
assumes "n is-ns→⇩d* n'" obtains ns' where "matched n ns' n'" and "set ns ⊆ set ns'"
proof(atomize_elim)
from ‹n is-ns→⇩d* n'› show "∃ns'. matched n ns' n' ∧ set ns ⊆ set ns'"
proof(induct rule:intra_sum_SDG_path.induct)
case (isSp_Nil n)
from ‹valid_SDG_node n› have "matched n [] n" by(rule matched_Nil)
thus ?case by fastforce
next
case (isSp_Append_cdep n ns n'' n')
from ‹∃ns'. matched n ns' n'' ∧ set ns ⊆ set ns'›
obtain ns' where "matched n ns' n''" and "set ns ⊆ set ns'" by blast
from ‹n'' s⟶⇘cd⇙ n'› have "n'' i-[]@[n'']→⇩d* n'"
by(fastforce intro:intra_SDG_path.intros sum_SDG_edge_valid_SDG_node
sum_SDG_edge_SDG_edge)
with ‹matched n ns' n''› have "matched n (ns'@[n'']) n'"
by(fastforce intro!:matched_Append_intra_SDG_path)
with ‹set ns ⊆ set ns'› show ?case by fastforce
next
case (isSp_Append_ddep n ns n'' V n')
from ‹∃ns'. matched n ns' n'' ∧ set ns ⊆ set ns'›
obtain ns' where "matched n ns' n''" and "set ns ⊆ set ns'" by blast
from ‹n'' s-V→⇩d⇩d n'› ‹n'' ≠ n'› have "n'' i-[]@[n'']→⇩d* n'"
by(fastforce intro:intra_SDG_path.intros sum_SDG_edge_valid_SDG_node
sum_SDG_edge_SDG_edge)
with ‹matched n ns' n''› have "matched n (ns'@[n'']) n'"
by(fastforce intro!:matched_Append_intra_SDG_path)
with ‹set ns ⊆ set ns'› show ?case by fastforce
next
case (isSp_Append_sum n ns n'' p n')
from ‹∃ns'. matched n ns' n'' ∧ set ns ⊆ set ns'›
obtain ns' where "matched n ns' n''" and "set ns ⊆ set ns'" by blast
from ‹n'' s-p→⇘sum⇙ n'› obtain ns'' where "matched n'' ns'' n'" and "n'' ∈ set ns''"
by -(erule sum_SDG_summary_edge_matched)
with ‹matched n ns' n''› have "matched n (ns'@ns'') n'" by -(rule matched_Append)
with ‹set ns ⊆ set ns'› ‹n'' ∈ set ns''› show ?case by fastforce
qed
qed
lemma is_SDG_path_intra_CFG_path:
assumes "n is-ns→⇩d* n'"
obtains as where "parent_node n -as→⇩ι* parent_node n'"
proof(atomize_elim)
from ‹n is-ns→⇩d* n'›
show "∃as. parent_node n -as→⇩ι* parent_node n'"
proof(induct rule:intra_sum_SDG_path.induct)
case (isSp_Nil n)
from ‹valid_SDG_node n› have "parent_node n -[]→* parent_node n"
by(fastforce intro:empty_path valid_SDG_CFG_node)
thus ?case by(auto simp:intra_path_def)
next
case (isSp_Append_cdep n ns n'' n')
from ‹∃as. parent_node n -as→⇩ι* parent_node n''›
obtain as where "parent_node n -as→⇩ι* parent_node n''" by blast
from ‹n'' s⟶⇘cd⇙ n'› have "n'' ⟶⇘cd⇙ n'" by(rule sum_SDG_edge_SDG_edge)
thus ?case
proof(rule cdep_edge_cases)
assume "parent_node n'' controls parent_node n'"
then obtain as' where "parent_node n'' -as'→⇩ι* parent_node n'" and "as' ≠ []"
by(erule control_dependence_path)
with ‹parent_node n -as→⇩ι* parent_node n''›
have "parent_node n -as@as'→⇩ι* parent_node n'" by -(rule intra_path_Append)
thus ?thesis by blast
next
fix a Q r p fs a'
assume "valid_edge a" and "kind a = Q:r↪⇘p⇙fs" "a' ∈ get_return_edges a"
and "parent_node n'' = targetnode a" and "parent_node n' = sourcenode a'"
then obtain a'' where "valid_edge a''" and "sourcenode a'' = targetnode a"
and "targetnode a'' = sourcenode a'" and "kind a'' = (λcf. False)⇩√"
by(auto dest:intra_proc_additional_edge)
hence "targetnode a -[a'']→⇩ι* sourcenode a'"
by(fastforce dest:path_edge simp:intra_path_def intra_kind_def)
with ‹parent_node n'' = targetnode a› ‹parent_node n' = sourcenode a'›
have "∃as'. parent_node n'' -as'→⇩ι* parent_node n' ∧ as' ≠ []" by fastforce
then obtain as' where "parent_node n'' -as'→⇩ι* parent_node n'" and "as' ≠ []"
by blast
with ‹parent_node n -as→⇩ι* parent_node n''›
have "parent_node n -as@as'→⇩ι* parent_node n'" by -(rule intra_path_Append)
thus ?thesis by blast
next
fix m assume "n'' = CFG_node m" and "m = parent_node n'"
with ‹parent_node n -as→⇩ι* parent_node n''› show ?thesis by fastforce
qed
next
case (isSp_Append_ddep n ns n'' V n')
from ‹∃as. parent_node n -as→⇩ι* parent_node n''›
obtain as where "parent_node n -as→⇩ι* parent_node n''" by blast
from ‹n'' s-V→⇩d⇩d n'› have "n'' influences V in n'"
by(fastforce elim:sum_SDG_edge.cases)
then obtain as' where "parent_node n'' -as'→⇩ι* parent_node n'"
by(auto simp:data_dependence_def)
with ‹parent_node n -as→⇩ι* parent_node n''›
have "parent_node n -as@as'→⇩ι* parent_node n'" by -(rule intra_path_Append)
thus ?case by blast
next
case (isSp_Append_sum n ns n'' p n')
from ‹∃as. parent_node n -as→⇩ι* parent_node n''›
obtain as where "parent_node n -as→⇩ι* parent_node n''" by blast
from ‹n'' s-p→⇘sum⇙ n'› obtain ns' where "matched n'' ns' n'"
by -(erule sum_SDG_summary_edge_matched)
then obtain as' where "parent_node n'' -as'→⇩ι* parent_node n'"
by(erule matched_intra_CFG_path)
with ‹parent_node n -as→⇩ι* parent_node n''›
have "parent_node n -as@as'→⇩ι* parent_node n'"
by(fastforce intro:path_Append simp:intra_path_def)
thus ?case by blast
qed
qed
text ‹SDG paths without return edges›
inductive intra_call_sum_SDG_path ::
"'node SDG_node ⇒ 'node SDG_node list ⇒ 'node SDG_node ⇒ bool"
("_ ics-_→⇩d* _" [51,0,0] 80)
where icsSp_Nil:
"valid_SDG_node n ⟹ n ics-[]→⇩d* n"
| icsSp_Append_cdep:
"⟦n ics-ns→⇩d* n''; n'' s⟶⇘cd⇙ n'⟧ ⟹ n ics-ns@[n'']→⇩d* n'"
| icsSp_Append_ddep:
"⟦n ics-ns→⇩d* n''; n'' s-V→⇩d⇩d n'; n'' ≠ n'⟧ ⟹ n ics-ns@[n'']→⇩d* n'"
| icsSp_Append_sum:
"⟦n ics-ns→⇩d* n''; n'' s-p→⇘sum⇙ n'⟧ ⟹ n ics-ns@[n'']→⇩d* n'"
| icsSp_Append_call:
"⟦n ics-ns→⇩d* n''; n'' s-p→⇘call⇙ n'⟧ ⟹ n ics-ns@[n'']→⇩d* n'"
| icsSp_Append_param_in:
"⟦n ics-ns→⇩d* n''; n'' s-p:V→⇘in⇙ n'⟧ ⟹ n ics-ns@[n'']→⇩d* n'"
lemma ics_SDG_path_valid_SDG_node:
assumes "n ics-ns→⇩d* n'" shows "valid_SDG_node n" and "valid_SDG_node n'"
using ‹n ics-ns→⇩d* n'›
by(induct rule:intra_call_sum_SDG_path.induct,
auto intro:sum_SDG_edge_valid_SDG_node valid_SDG_CFG_node)
lemma ics_SDG_path_Append:
"⟦n'' ics-ns'→⇩d* n'; n ics-ns→⇩d* n''⟧ ⟹ n ics-ns@ns'→⇩d* n'"
by(induct rule:intra_call_sum_SDG_path.induct,
auto intro:intra_call_sum_SDG_path.intros simp:append_assoc[THEN sym]
simp del:append_assoc)
lemma is_SDG_path_ics_SDG_path:
"n is-ns→⇩d* n' ⟹ n ics-ns→⇩d* n'"
by(induct rule:intra_sum_SDG_path.induct,auto intro:intra_call_sum_SDG_path.intros)
lemma cc_SDG_path_ics_SDG_path:
"n cc-ns→⇩d* n' ⟹ n ics-ns→⇩d* n'"
by(induct rule:call_cdep_SDG_path.induct,
auto intro:intra_call_sum_SDG_path.intros SDG_edge_sum_SDG_edge)
lemma ics_SDG_path_split:
assumes "n ics-ns→⇩d* n'" and "n'' ∈ set ns"
obtains ns' ns'' where "ns = ns'@ns''" and "n ics-ns'→⇩d* n''"
and "n'' ics-ns''→⇩d* n'"
proof(atomize_elim)
from ‹n ics-ns→⇩d* n'› ‹n'' ∈ set ns›
show "∃ns' ns''. ns = ns'@ns'' ∧ n ics-ns'→⇩d* n'' ∧ n'' ics-ns''→⇩d* n'"
proof(induct rule:intra_call_sum_SDG_path.induct)
case icsSp_Nil thus ?case by simp
next
case (icsSp_Append_cdep n ns nx n')
note IH = ‹n'' ∈ set ns ⟹
∃ns' ns''. ns = ns' @ ns'' ∧ n ics-ns'→⇩d* n'' ∧ n'' ics-ns''→⇩d* nx›
from ‹n'' ∈ set (ns@[nx])› have "n'' ∈ set ns ∨ n'' = nx" by fastforce
thus ?case
proof
assume "n'' ∈ set ns"
from IH[OF this] obtain ns' ns'' where "ns = ns' @ ns''"
and "n ics-ns'→⇩d* n''" and "n'' ics-ns''→⇩d* nx" by blast
from ‹n'' ics-ns''→⇩d* nx› ‹nx s⟶⇘cd⇙ n'›
have "n'' ics-ns''@[nx]→⇩d* n'"
by(rule intra_call_sum_SDG_path.icsSp_Append_cdep)
with ‹ns = ns'@ns''› ‹n ics-ns'→⇩d* n''› show ?thesis by fastforce
next
assume "n'' = nx"
from ‹nx s⟶⇘cd⇙ n'› have "nx ics-[]→⇩d* nx"
by(fastforce intro:icsSp_Nil SDG_edge_valid_SDG_node sum_SDG_edge_SDG_edge)
with ‹nx s⟶⇘cd⇙ n'› have "nx ics-[]@[nx]→⇩d* n'"
by -(rule intra_call_sum_SDG_path.icsSp_Append_cdep)
with ‹n ics-ns→⇩d* nx› ‹n'' = nx› show ?thesis by fastforce
qed
next
case (icsSp_Append_ddep n ns nx V n')
note IH = ‹n'' ∈ set ns ⟹
∃ns' ns''. ns = ns' @ ns'' ∧ n ics-ns'→⇩d* n'' ∧ n'' ics-ns''→⇩d* nx›
from ‹n'' ∈ set (ns@[nx])› have "n'' ∈ set ns ∨ n'' = nx" by fastforce
thus ?case
proof
assume "n'' ∈ set ns"
from IH[OF this] obtain ns' ns'' where "ns = ns' @ ns''"
and "n ics-ns'→⇩d* n''" and "n'' ics-ns''→⇩d* nx" by blast
from ‹n'' ics-ns''→⇩d* nx› ‹nx s-V→⇩d⇩d n'› ‹nx ≠ n'›
have "n'' ics-ns''@[nx]→⇩d* n'"
by(rule intra_call_sum_SDG_path.icsSp_Append_ddep)
with ‹ns = ns'@ns''› ‹n ics-ns'→⇩d* n''› show ?thesis by fastforce
next
assume "n'' = nx"
from ‹nx s-V→⇩d⇩d n'› have "nx ics-[]→⇩d* nx"
by(fastforce intro:icsSp_Nil SDG_edge_valid_SDG_node sum_SDG_edge_SDG_edge)
with ‹nx s-V→⇩d⇩d n'› ‹nx ≠ n'› have "nx ics-[]@[nx]→⇩d* n'"
by -(rule intra_call_sum_SDG_path.icsSp_Append_ddep)
with ‹n ics-ns→⇩d* nx› ‹n'' = nx› show ?thesis by fastforce
qed
next
case (icsSp_Append_sum n ns nx p n')
note IH = ‹n'' ∈ set ns ⟹
∃ns' ns''. ns = ns' @ ns'' ∧ n ics-ns'→⇩d* n'' ∧ n'' ics-ns''→⇩d* nx›
from ‹n'' ∈ set (ns@[nx])› have "n'' ∈ set ns ∨ n'' = nx" by fastforce
thus ?case
proof
assume "n'' ∈ set ns"
from IH[OF this] obtain ns' ns'' where "ns = ns' @ ns''"
and "n ics-ns'→⇩d* n''" and "n'' ics-ns''→⇩d* nx" by blast
from ‹n'' ics-ns''→⇩d* nx› ‹nx s-p→⇘sum⇙ n'›
have "n'' ics-ns''@[nx]→⇩d* n'"
by(rule intra_call_sum_SDG_path.icsSp_Append_sum)
with ‹ns = ns'@ns''› ‹n ics-ns'→⇩d* n''› show ?thesis by fastforce
next
assume "n'' = nx"
from ‹nx s-p→⇘sum⇙ n'› have "valid_SDG_node nx"
by(fastforce elim:sum_SDG_edge.cases)
hence "nx ics-[]→⇩d* nx" by(fastforce intro:icsSp_Nil)
with ‹nx s-p→⇘sum⇙ n'› have "nx ics-[]@[nx]→⇩d* n'"
by -(rule intra_call_sum_SDG_path.icsSp_Append_sum)
with ‹n ics-ns→⇩d* nx› ‹n'' = nx› show ?thesis by fastforce
qed
next
case (icsSp_Append_call n ns nx p n')
note IH = ‹n'' ∈ set ns ⟹
∃ns' ns''. ns = ns' @ ns'' ∧ n ics-ns'→⇩d* n'' ∧ n'' ics-ns''→⇩d* nx›
from ‹n'' ∈ set (ns@[nx])› have "n'' ∈ set ns ∨ n'' = nx" by fastforce
thus ?case
proof
assume "n'' ∈ set ns"
from IH[OF this] obtain ns' ns'' where "ns = ns' @ ns''"
and "n ics-ns'→⇩d* n''" and "n'' ics-ns''→⇩d* nx" by blast
from ‹n'' ics-ns''→⇩d* nx› ‹nx s-p→⇘call⇙ n'›
have "n'' ics-ns''@[nx]→⇩d* n'"
by(rule intra_call_sum_SDG_path.icsSp_Append_call)
with ‹ns = ns'@ns''› ‹n ics-ns'→⇩d* n''› show ?thesis by fastforce
next
assume "n'' = nx"
from ‹nx s-p→⇘call⇙ n'› have "nx ics-[]→⇩d* nx"
by(fastforce intro:icsSp_Nil SDG_edge_valid_SDG_node sum_SDG_edge_SDG_edge)
with ‹nx s-p→⇘call⇙ n'› have "nx ics-[]@[nx]→⇩d* n'"
by -(rule intra_call_sum_SDG_path.icsSp_Append_call)
with ‹n ics-ns→⇩d* nx› ‹n'' = nx› show ?thesis by fastforce
qed
next
case (icsSp_Append_param_in n ns nx p V n')
note IH = ‹n'' ∈ set ns ⟹
∃ns' ns''. ns = ns' @ ns'' ∧ n ics-ns'→⇩d* n'' ∧ n'' ics-ns''→⇩d* nx›
from ‹n'' ∈ set (ns@[nx])› have "n'' ∈ set ns ∨ n'' = nx" by fastforce
thus ?case
proof
assume "n'' ∈ set ns"
from IH[OF this] obtain ns' ns'' where "ns = ns' @ ns''"
and "n ics-ns'→⇩d* n''" and "n'' ics-ns''→⇩d* nx" by blast
from ‹n'' ics-ns''→⇩d* nx› ‹nx s-p:V→⇘in⇙ n'›
have "n'' ics-ns''@[nx]→⇩d* n'"
by(rule intra_call_sum_SDG_path.icsSp_Append_param_in)
with ‹ns = ns'@ns''› ‹n ics-ns'→⇩d* n''› show ?thesis by fastforce
next
assume "n'' = nx"
from ‹nx s-p:V→⇘in⇙ n'› have "nx ics-[]→⇩d* nx"
by(fastforce intro:icsSp_Nil SDG_edge_valid_SDG_node sum_SDG_edge_SDG_edge)
with ‹nx s-p:V→⇘in⇙ n'› have "nx ics-[]@[nx]→⇩d* n'"
by -(rule intra_call_sum_SDG_path.icsSp_Append_param_in)
with ‹n ics-ns→⇩d* nx› ‹n'' = nx› show ?thesis by fastforce
qed
qed
qed
lemma realizable_ics_SDG_path:
assumes "realizable n ns n'" obtains ns' where "n ics-ns'→⇩d* n'"
proof(atomize_elim)
from ‹realizable n ns n'› show "∃ns'. n ics-ns'→⇩d* n'"
proof(induct rule:realizable.induct)
case (realizable_matched n ns n')
from ‹matched n ns n'› obtain ns' where "n is-ns'→⇩d* n'"
by(erule matched_is_SDG_path)
thus ?case by(fastforce intro:is_SDG_path_ics_SDG_path)
next
case (realizable_call n⇩0 ns n⇩1 p n⇩2 V ns' n⇩3)
from ‹∃ns'. n⇩0 ics-ns'→⇩d* n⇩1› obtain nsx where "n⇩0 ics-nsx→⇩d* n⇩1" by blast
with ‹n⇩1 -p→⇘call⇙ n⇩2 ∨ n⇩1 -p:V→⇘in⇙ n⇩2› have "n⇩0 ics-nsx@[n⇩1]→⇩d* n⇩2"
by(fastforce intro:SDG_edge_sum_SDG_edge icsSp_Append_call icsSp_Append_param_in)
from ‹matched n⇩2 ns' n⇩3› obtain nsx' where "n⇩2 is-nsx'→⇩d* n⇩3"
by(erule matched_is_SDG_path)
hence "n⇩2 ics-nsx'→⇩d* n⇩3" by(rule is_SDG_path_ics_SDG_path)
from ‹n⇩2 ics-nsx'→⇩d* n⇩3› ‹n⇩0 ics-nsx@[n⇩1]→⇩d* n⇩2›
have "n⇩0 ics-(nsx@[n⇩1])@nsx'→⇩d* n⇩3" by(rule ics_SDG_path_Append)
thus ?case by blast
qed
qed
lemma ics_SDG_path_realizable:
assumes "n ics-ns→⇩d* n'"
obtains ns' where "realizable n ns' n'" and "set ns ⊆ set ns'"
proof(atomize_elim)
from ‹n ics-ns→⇩d* n'› show "∃ns'. realizable n ns' n' ∧ set ns ⊆ set ns'"
proof(induct rule:intra_call_sum_SDG_path.induct)
case (icsSp_Nil n)
hence "matched n [] n" by(rule matched_Nil)
thus ?case by(fastforce intro:realizable_matched)
next
case (icsSp_Append_cdep n ns n'' n')
from ‹∃ns'. realizable n ns' n'' ∧ set ns ⊆ set ns'›
obtain ns' where "realizable n ns' n''" and "set ns ⊆ set ns'" by blast
from ‹n'' s⟶⇘cd⇙ n'› have "valid_SDG_node n''" by(rule sum_SDG_edge_valid_SDG_node)
hence "n'' i-[]→⇩d* n''" by(rule iSp_Nil)
with ‹n'' s⟶⇘cd⇙ n'› have "n'' i-[]@[n'']→⇩d* n'"
by(fastforce elim:iSp_Append_cdep sum_SDG_edge_SDG_edge)
hence "matched n'' [n''] n'" by(fastforce intro:intra_SDG_path_matched)
with ‹realizable n ns' n''› have "realizable n (ns'@[n'']) n'"
by(rule realizable_Append_matched)
with ‹set ns ⊆ set ns'› show ?case by fastforce
next
case (icsSp_Append_ddep n ns n'' V n')
from ‹∃ns'. realizable n ns' n'' ∧ set ns ⊆ set ns'›
obtain ns' where "realizable n ns' n''" and "set ns ⊆ set ns'" by blast
from ‹n'' s-V→⇩d⇩d n'› have "valid_SDG_node n''"
by(rule sum_SDG_edge_valid_SDG_node)
hence "n'' i-[]→⇩d* n''" by(rule iSp_Nil)
with ‹n'' s-V→⇩d⇩d n'› ‹n'' ≠ n'› have "n'' i-[]@[n'']→⇩d* n'"
by(fastforce elim:iSp_Append_ddep sum_SDG_edge_SDG_edge)
hence "matched n'' [n''] n'" by(fastforce intro:intra_SDG_path_matched)
with ‹realizable n ns' n''› have "realizable n (ns'@[n'']) n'"
by(fastforce intro:realizable_Append_matched)
with ‹set ns ⊆ set ns'› show ?case by fastforce
next
case (icsSp_Append_sum n ns n'' p n')
from ‹∃ns'. realizable n ns' n'' ∧ set ns ⊆ set ns'›
obtain ns' where "realizable n ns' n''" and "set ns ⊆ set ns'" by blast
from ‹n'' s-p→⇘sum⇙ n'› show ?case
proof(rule sum_edge_cases)
fix a Q r fs a'
assume "valid_edge a" and "kind a = Q:r↪⇘p⇙fs" and "a' ∈ get_return_edges a"
and "n'' = CFG_node (sourcenode a)" and "n' = CFG_node (targetnode a')"
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹a' ∈ get_return_edges a›
have match':"matched (CFG_node (targetnode a)) [CFG_node (targetnode a)]
(CFG_node (sourcenode a'))"
by(rule intra_proc_matched)
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹n'' = CFG_node (sourcenode a)›
have "n'' -p→⇘call⇙ CFG_node (targetnode a)"
by(fastforce intro:SDG_call_edge)
hence "matched n'' [] n''"
by(fastforce intro:matched_Nil SDG_edge_valid_SDG_node)
from ‹valid_edge a› ‹a' ∈ get_return_edges a› have "valid_edge a'"
by(rule get_return_edges_valid)
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹a' ∈ get_return_edges a›
obtain Q' f' where "kind a' = Q'↩⇘p⇙f'" by(fastforce dest!:call_return_edges)
from ‹valid_edge a'› ‹kind a' = Q'↩⇘p⇙f'› ‹n' = CFG_node (targetnode a')›
have "CFG_node (sourcenode a') -p→⇘ret⇙ n'"
by(fastforce intro:SDG_return_edge)
from ‹matched n'' [] n''› ‹n'' -p→⇘call⇙ CFG_node (targetnode a)›
match' ‹CFG_node (sourcenode a') -p→⇘ret⇙ n'› ‹valid_edge a›
‹a' ∈ get_return_edges a› ‹n' = CFG_node (targetnode a')›
‹n'' = CFG_node (sourcenode a)›
have "matched n'' ([]@n''#[CFG_node (targetnode a)]@[CFG_node (sourcenode a')])
n'"
by(fastforce intro:matched_bracket_call)
with ‹realizable n ns' n''›
have "realizable n
(ns'@(n''#[CFG_node (targetnode a),CFG_node (sourcenode a')])) n'"
by(fastforce intro:realizable_Append_matched)
with ‹set ns ⊆ set ns'› show ?thesis by fastforce
next
fix a Q r p fs a' ns'' x x' ins outs
assume "valid_edge a" and "kind a = Q:r↪⇘p⇙fs" and "a' ∈ get_return_edges a"
and match':"matched (Formal_in (targetnode a,x)) ns''
(Formal_out (sourcenode a',x'))"
and "n'' = Actual_in (sourcenode a,x)"
and "n' = Actual_out (targetnode a',x')" and "(p,ins,outs) ∈ set procs"
and "x < length ins" and "x' < length outs"
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹n'' = Actual_in (sourcenode a,x)›
‹(p,ins,outs) ∈ set procs› ‹x < length ins›
have "n'' -p:ins!x→⇘in⇙ Formal_in (targetnode a,x)"
by(fastforce intro!:SDG_param_in_edge)
hence "matched n'' [] n''"
by(fastforce intro:matched_Nil SDG_edge_valid_SDG_node)
from ‹valid_edge a› ‹a' ∈ get_return_edges a› have "valid_edge a'"
by(rule get_return_edges_valid)
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹a' ∈ get_return_edges a›
obtain Q' f' where "kind a' = Q'↩⇘p⇙f'" by(fastforce dest!:call_return_edges)
from ‹valid_edge a'› ‹kind a' = Q'↩⇘p⇙f'› ‹n' = Actual_out (targetnode a',x')›
‹(p,ins,outs) ∈ set procs› ‹x' < length outs›
have "Formal_out (sourcenode a',x') -p:outs!x'→⇘out⇙ n'"
by(fastforce intro:SDG_param_out_edge)
from ‹matched n'' [] n''› ‹n'' -p:ins!x→⇘in⇙ Formal_in (targetnode a,x)›
match' ‹Formal_out (sourcenode a',x') -p:outs!x'→⇘out⇙ n'› ‹valid_edge a›
‹a' ∈ get_return_edges a› ‹n' = Actual_out (targetnode a',x')›
‹n'' = Actual_in (sourcenode a,x)›
have "matched n'' ([]@n''#ns''@[Formal_out (sourcenode a',x')]) n'"
by(fastforce intro:matched_bracket_param)
with ‹realizable n ns' n''›
have "realizable n (ns'@(n''#ns''@[Formal_out (sourcenode a',x')])) n'"
by(fastforce intro:realizable_Append_matched)
with ‹set ns ⊆ set ns'› show ?thesis by fastforce
qed
next
case (icsSp_Append_call n ns n'' p n')
from ‹∃ns'. realizable n ns' n'' ∧ set ns ⊆ set ns'›
obtain ns' where "realizable n ns' n''" and "set ns ⊆ set ns'" by blast
from ‹n'' s-p→⇘call⇙ n'› have "valid_SDG_node n'"
by(rule sum_SDG_edge_valid_SDG_node)
hence "matched n' [] n'" by(rule matched_Nil)
with ‹realizable n ns' n''› ‹n'' s-p→⇘call⇙ n'›
have "realizable n (ns'@n''#[]) n'"
by(fastforce intro:realizable_call sum_SDG_edge_SDG_edge)
with ‹set ns ⊆ set ns'› show ?case by fastforce
next
case (icsSp_Append_param_in n ns n'' p V n')
from ‹∃ns'. realizable n ns' n'' ∧ set ns ⊆ set ns'›
obtain ns' where "realizable n ns' n''" and "set ns ⊆ set ns'" by blast
from ‹n'' s-p:V→⇘in⇙ n'› have "valid_SDG_node n'"
by(rule sum_SDG_edge_valid_SDG_node)
hence "matched n' [] n'" by(rule matched_Nil)
with ‹realizable n ns' n''› ‹n'' s-p:V→⇘in⇙ n'›
have "realizable n (ns'@n''#[]) n'"
by(fastforce intro:realizable_call sum_SDG_edge_SDG_edge)
with ‹set ns ⊆ set ns'› show ?case by fastforce
qed
qed
lemma realizable_Append_ics_SDG_path:
assumes "realizable n ns n''" and "n'' ics-ns'→⇩d* n'"
obtains ns'' where "realizable n (ns@ns'') n'"
proof(atomize_elim)
from ‹n'' ics-ns'→⇩d* n'› ‹realizable n ns n''›
show "∃ns''. realizable n (ns@ns'') n'"
proof(induct rule:intra_call_sum_SDG_path.induct)
case (icsSp_Nil n'') thus ?case by(rule_tac x="[]" in exI) fastforce
next
case (icsSp_Append_cdep n'' ns' nx n')
then obtain ns'' where "realizable n (ns@ns'') nx" by fastforce
from ‹nx s⟶⇘cd⇙ n'› have "valid_SDG_node nx" by(rule sum_SDG_edge_valid_SDG_node)
hence "matched nx [] nx" by(rule matched_Nil)
from ‹nx s⟶⇘cd⇙ n'› ‹valid_SDG_node nx›
have "nx i-[]@[nx]→⇩d* n'"
by(fastforce intro:iSp_Append_cdep iSp_Nil sum_SDG_edge_SDG_edge)
with ‹matched nx [] nx› have "matched nx ([]@[nx]) n'"
by(fastforce intro:matched_Append_intra_SDG_path)
with ‹realizable n (ns@ns'') nx› have "realizable n ((ns@ns'')@[nx]) n'"
by(fastforce intro:realizable_Append_matched)
thus ?case by fastforce
next
case (icsSp_Append_ddep n'' ns' nx V n')
then obtain ns'' where "realizable n (ns@ns'') nx" by fastforce
from ‹nx s-V→⇩d⇩d n'› have "valid_SDG_node nx" by(rule sum_SDG_edge_valid_SDG_node)
hence "matched nx [] nx" by(rule matched_Nil)
from ‹nx s-V→⇩d⇩d n'› ‹nx ≠ n'› ‹valid_SDG_node nx›
have "nx i-[]@[nx]→⇩d* n'"
by(fastforce intro:iSp_Append_ddep iSp_Nil sum_SDG_edge_SDG_edge)
with ‹matched nx [] nx› have "matched nx ([]@[nx]) n'"
by(fastforce intro:matched_Append_intra_SDG_path)
with ‹realizable n (ns@ns'') nx› have "realizable n ((ns@ns'')@[nx]) n'"
by(fastforce intro:realizable_Append_matched)
thus ?case by fastforce
next
case (icsSp_Append_sum n'' ns' nx p n')
then obtain ns'' where "realizable n (ns@ns'') nx" by fastforce
from ‹nx s-p→⇘sum⇙ n'› obtain nsx where "matched nx nsx n'"
by -(erule sum_SDG_summary_edge_matched)
with ‹realizable n (ns@ns'') nx› have "realizable n ((ns@ns'')@nsx) n'"
by(rule realizable_Append_matched)
thus ?case by fastforce
next
case (icsSp_Append_call n'' ns' nx p n')
then obtain ns'' where "realizable n (ns@ns'') nx" by fastforce
from ‹nx s-p→⇘call⇙ n'› have "valid_SDG_node n'" by(rule sum_SDG_edge_valid_SDG_node)
hence "matched n' [] n'" by(rule matched_Nil)
with ‹realizable n (ns@ns'') nx› ‹nx s-p→⇘call⇙ n'›
have "realizable n ((ns@ns'')@[nx]) n'"
by(fastforce intro:realizable_call sum_SDG_edge_SDG_edge)
thus ?case by fastforce
next
case (icsSp_Append_param_in n'' ns' nx p V n')
then obtain ns'' where "realizable n (ns@ns'') nx" by fastforce
from ‹nx s-p:V→⇘in⇙ n'› have "valid_SDG_node n'"
by(rule sum_SDG_edge_valid_SDG_node)
hence "matched n' [] n'" by(rule matched_Nil)
with ‹realizable n (ns@ns'') nx› ‹nx s-p:V→⇘in⇙ n'›
have "realizable n ((ns@ns'')@[nx]) n'"
by(fastforce intro:realizable_call sum_SDG_edge_SDG_edge)
thus ?case by fastforce
qed
qed
subsection ‹SDG paths without call edges›
inductive intra_return_sum_SDG_path ::
"'node SDG_node ⇒ 'node SDG_node list ⇒ 'node SDG_node ⇒ bool"
("_ irs-_→⇩d* _" [51,0,0] 80)
where irsSp_Nil:
"valid_SDG_node n ⟹ n irs-[]→⇩d* n"
| irsSp_Cons_cdep:
"⟦n'' irs-ns→⇩d* n'; n s⟶⇘cd⇙ n''⟧ ⟹ n irs-n#ns→⇩d* n'"
| irsSp_Cons_ddep:
"⟦n'' irs-ns→⇩d* n'; n s-V→⇩d⇩d n''; n ≠ n''⟧ ⟹ n irs-n#ns→⇩d* n'"
| irsSp_Cons_sum:
"⟦n'' irs-ns→⇩d* n'; n s-p→⇘sum⇙ n''⟧ ⟹ n irs-n#ns→⇩d* n'"
| irsSp_Cons_return:
"⟦n'' irs-ns→⇩d* n'; n s-p→⇘ret⇙ n''⟧ ⟹ n irs-n#ns→⇩d* n'"
| irsSp_Cons_param_out:
"⟦n'' irs-ns→⇩d* n'; n s-p:V→⇘out⇙ n''⟧ ⟹ n irs-n#ns→⇩d* n'"
lemma irs_SDG_path_Append:
"⟦n irs-ns→⇩d* n''; n'' irs-ns'→⇩d* n'⟧ ⟹ n irs-ns@ns'→⇩d* n'"
by(induct rule:intra_return_sum_SDG_path.induct,
auto intro:intra_return_sum_SDG_path.intros)
lemma is_SDG_path_irs_SDG_path:
"n is-ns→⇩d* n' ⟹ n irs-ns→⇩d* n'"
proof(induct rule:intra_sum_SDG_path.induct)
case (isSp_Nil n)
from ‹valid_SDG_node n› show ?case by(rule irsSp_Nil)
next
case (isSp_Append_cdep n ns n'' n')
from ‹n'' s⟶⇘cd⇙ n'› have "n'' irs-[n'']→⇩d* n'"
by(fastforce intro:irsSp_Cons_cdep irsSp_Nil sum_SDG_edge_valid_SDG_node)
with ‹n irs-ns→⇩d* n''› show ?case by(rule irs_SDG_path_Append)
next
case (isSp_Append_ddep n ns n'' V n')
from ‹n'' s-V→⇩d⇩d n'› ‹n'' ≠ n'› have "n'' irs-[n'']→⇩d* n'"
by(fastforce intro:irsSp_Cons_ddep irsSp_Nil sum_SDG_edge_valid_SDG_node)
with ‹n irs-ns→⇩d* n''› show ?case by(rule irs_SDG_path_Append)
next
case (isSp_Append_sum n ns n'' p n')
from ‹n'' s-p→⇘sum⇙ n'› have "n'' irs-[n'']→⇩d* n'"
by(fastforce intro:irsSp_Cons_sum irsSp_Nil sum_SDG_edge_valid_SDG_node)
with ‹n irs-ns→⇩d* n''› show ?case by(rule irs_SDG_path_Append)
qed
lemma irs_SDG_path_split:
assumes "n irs-ns→⇩d* n'"
obtains "n is-ns→⇩d* n'"
| nsx nsx' nx nx' p where "ns = nsx@nx#nsx'" and "n irs-nsx→⇩d* nx"
and "nx s-p→⇘ret⇙ nx' ∨ (∃V. nx s-p:V→⇘out⇙ nx')" and "nx' is-nsx'→⇩d* n'"
proof(atomize_elim)
from ‹n irs-ns→⇩d* n'› show "n is-ns→⇩d* n' ∨
(∃nsx nx nsx' p nx'. ns = nsx@nx#nsx' ∧ n irs-nsx→⇩d* nx ∧
(nx s-p→⇘ret⇙ nx' ∨ (∃V. nx s-p:V→⇘out⇙ nx')) ∧ nx' is-nsx'→⇩d* n')"
proof(induct rule:intra_return_sum_SDG_path.induct)
case (irsSp_Nil n)
from ‹valid_SDG_node n› have "n is-[]→⇩d* n" by(rule isSp_Nil)
thus ?case by simp
next
case (irsSp_Cons_cdep n'' ns n' n)
from ‹n'' is-ns→⇩d* n' ∨
(∃nsx nx nsx' p nx'. ns = nsx@nx#nsx' ∧ n'' irs-nsx→⇩d* nx ∧
(nx s-p→⇘ret⇙ nx' ∨ (∃V. nx s-p:V→⇘out⇙ nx')) ∧ nx' is-nsx'→⇩d* n')›
show ?case
proof
assume "n'' is-ns→⇩d* n'"
from ‹n s⟶⇘cd⇙ n''› have "n is-[]@[n]→⇩d* n''"
by(fastforce intro:isSp_Append_cdep isSp_Nil sum_SDG_edge_valid_SDG_node)
with ‹n'' is-ns→⇩d* n'› have "n is-[n]@ns→⇩d* n'"
by(fastforce intro:is_SDG_path_Append)
thus ?case by simp
next
assume "∃nsx nx nsx' p nx'. ns = nsx@nx#nsx' ∧ n'' irs-nsx→⇩d* nx ∧
(nx s-p→⇘ret⇙ nx' ∨ (∃V. nx s-p:V→⇘out⇙ nx')) ∧ nx' is-nsx'→⇩d* n'"
then obtain nsx nsx' nx nx' p where "ns = nsx@nx#nsx'" and "n'' irs-nsx→⇩d* nx"
and "nx s-p→⇘ret⇙ nx' ∨ (∃V. nx s-p:V→⇘out⇙ nx')" and "nx' is-nsx'→⇩d* n'" by blast
from ‹n'' irs-nsx→⇩d* nx› ‹n s⟶⇘cd⇙ n''› have "n irs-n#nsx→⇩d* nx"
by(rule intra_return_sum_SDG_path.irsSp_Cons_cdep)
with ‹ns = nsx@nx#nsx'› ‹nx s-p→⇘ret⇙ nx' ∨ (∃V. nx s-p:V→⇘out⇙ nx')›
‹nx' is-nsx'→⇩d* n'›
show ?case by fastforce
qed
next
case (irsSp_Cons_ddep n'' ns n' n V)
from ‹n'' is-ns→⇩d* n' ∨
(∃nsx nx nsx' p nx'. ns = nsx@nx#nsx' ∧ n'' irs-nsx→⇩d* nx ∧
(nx s-p→⇘ret⇙ nx' ∨ (∃V. nx s-p:V→⇘out⇙ nx')) ∧ nx' is-nsx'→⇩d* n')›
show ?case
proof
assume "n'' is-ns→⇩d* n'"
from ‹n s-V→⇩d⇩d n''› ‹n ≠ n''› have "n is-[]@[n]→⇩d* n''"
by(fastforce intro:isSp_Append_ddep isSp_Nil sum_SDG_edge_valid_SDG_node)
with ‹n'' is-ns→⇩d* n'› have "n is-[n]@ns→⇩d* n'"
by(fastforce intro:is_SDG_path_Append)
thus ?case by simp
next
assume "∃nsx nx nsx' p nx'. ns = nsx@nx#nsx' ∧ n'' irs-nsx→⇩d* nx ∧
(nx s-p→⇘ret⇙ nx' ∨ (∃V. nx s-p:V→⇘out⇙ nx')) ∧ nx' is-nsx'→⇩d* n'"
then obtain nsx nsx' nx nx' p where "ns = nsx@nx#nsx'" and "n'' irs-nsx→⇩d* nx"
and "nx s-p→⇘ret⇙ nx' ∨ (∃V. nx s-p:V→⇘out⇙ nx')" and "nx' is-nsx'→⇩d* n'" by blast
from ‹n'' irs-nsx→⇩d* nx› ‹n s-V→⇩d⇩d n''› ‹n ≠ n''› have "n irs-n#nsx→⇩d* nx"
by(rule intra_return_sum_SDG_path.irsSp_Cons_ddep)
with ‹ns = nsx@nx#nsx'› ‹nx s-p→⇘ret⇙ nx' ∨ (∃V. nx s-p:V→⇘out⇙ nx')›
‹nx' is-nsx'→⇩d* n'›
show ?case by fastforce
qed
next
case (irsSp_Cons_sum n'' ns n' n p)
from ‹n'' is-ns→⇩d* n' ∨
(∃nsx nx nsx' p nx'. ns = nsx@nx#nsx' ∧ n'' irs-nsx→⇩d* nx ∧
(nx s-p→⇘ret⇙ nx' ∨ (∃V. nx s-p:V→⇘out⇙ nx')) ∧ nx' is-nsx'→⇩d* n')›
show ?case
proof
assume "n'' is-ns→⇩d* n'"
from ‹n s-p→⇘sum⇙ n''› have "n is-[]@[n]→⇩d* n''"
by(fastforce intro:isSp_Append_sum isSp_Nil sum_SDG_edge_valid_SDG_node)
with ‹n'' is-ns→⇩d* n'› have "n is-[n]@ns→⇩d* n'"
by(fastforce intro:is_SDG_path_Append)
thus ?case by simp
next
assume "∃nsx nx nsx' p nx'. ns = nsx@nx#nsx' ∧ n'' irs-nsx→⇩d* nx ∧
(nx s-p→⇘ret⇙ nx' ∨ (∃V. nx s-p:V→⇘out⇙ nx')) ∧ nx' is-nsx'→⇩d* n'"
then obtain nsx nsx' nx nx' p' where "ns = nsx@nx#nsx'" and "n'' irs-nsx→⇩d* nx"
and "nx s-p'→⇘ret⇙ nx' ∨ (∃V. nx s-p':V→⇘out⇙ nx')"
and "nx' is-nsx'→⇩d* n'" by blast
from ‹n'' irs-nsx→⇩d* nx› ‹n s-p→⇘sum⇙ n''› have "n irs-n#nsx→⇩d* nx"
by(rule intra_return_sum_SDG_path.irsSp_Cons_sum)
with ‹ns = nsx@nx#nsx'› ‹nx s-p'→⇘ret⇙ nx' ∨ (∃V. nx s-p':V→⇘out⇙ nx')›
‹nx' is-nsx'→⇩d* n'›
show ?case by fastforce
qed
next
case (irsSp_Cons_return n'' ns n' n p)
from ‹n'' is-ns→⇩d* n' ∨
(∃nsx nx nsx' p nx'. ns = nsx@nx#nsx' ∧ n'' irs-nsx→⇩d* nx ∧
(nx s-p→⇘ret⇙ nx' ∨ (∃V. nx s-p:V→⇘out⇙ nx')) ∧ nx' is-nsx'→⇩d* n')›
show ?case
proof
assume "n'' is-ns→⇩d* n'"
from ‹n s-p→⇘ret⇙ n''› have "valid_SDG_node n" by(rule sum_SDG_edge_valid_SDG_node)
hence "n irs-[]→⇩d* n" by(rule irsSp_Nil)
with ‹n s-p→⇘ret⇙ n''› ‹n'' is-ns→⇩d* n'› show ?thesis by fastforce
next
assume "∃nsx nx nsx' p nx'. ns = nsx@nx#nsx' ∧ n'' irs-nsx→⇩d* nx ∧
(nx s-p→⇘ret⇙ nx' ∨ (∃V. nx s-p:V→⇘out⇙ nx')) ∧ nx' is-nsx'→⇩d* n'"
then obtain nsx nsx' nx nx' p' where "ns = nsx@nx#nsx'" and "n'' irs-nsx→⇩d* nx"
and "nx s-p'→⇘ret⇙ nx' ∨ (∃V. nx s-p':V→⇘out⇙ nx')"
and "nx' is-nsx'→⇩d* n'" by blast
from ‹n'' irs-nsx→⇩d* nx› ‹n s-p→⇘ret⇙ n''› have "n irs-n#nsx→⇩d* nx"
by(rule intra_return_sum_SDG_path.irsSp_Cons_return)
with ‹ns = nsx@nx#nsx'› ‹nx s-p'→⇘ret⇙ nx' ∨ (∃V. nx s-p':V→⇘out⇙ nx')›
‹nx' is-nsx'→⇩d* n'›
show ?thesis by fastforce
qed
next
case (irsSp_Cons_param_out n'' ns n' n p V)
from ‹n'' is-ns→⇩d* n' ∨
(∃nsx nx nsx' p nx'. ns = nsx@nx#nsx' ∧ n'' irs-nsx→⇩d* nx ∧
(nx s-p→⇘ret⇙ nx' ∨ (∃V. nx s-p:V→⇘out⇙ nx')) ∧ nx' is-nsx'→⇩d* n')›
show ?case
proof
assume "n'' is-ns→⇩d* n'"
from ‹n s-p:V→⇘out⇙ n''› have "valid_SDG_node n"
by(rule sum_SDG_edge_valid_SDG_node)
hence "n irs-[]→⇩d* n" by(rule irsSp_Nil)
with ‹n s-p:V→⇘out⇙ n''› ‹n'' is-ns→⇩d* n'› show ?thesis by fastforce
next
assume "∃nsx nx nsx' p nx'. ns = nsx@nx#nsx' ∧ n'' irs-nsx→⇩d* nx ∧
(nx s-p→⇘ret⇙ nx' ∨ (∃V. nx s-p:V→⇘out⇙ nx')) ∧ nx' is-nsx'→⇩d* n'"
then obtain nsx nsx' nx nx' p' where "ns = nsx@nx#nsx'" and "n'' irs-nsx→⇩d* nx"
and "nx s-p'→⇘ret⇙ nx' ∨ (∃V. nx s-p':V→⇘out⇙ nx')"
and "nx' is-nsx'→⇩d* n'" by blast
from ‹n'' irs-nsx→⇩d* nx› ‹n s-p:V→⇘out⇙ n''› have "n irs-n#nsx→⇩d* nx"
by(rule intra_return_sum_SDG_path.irsSp_Cons_param_out)
with ‹ns = nsx@nx#nsx'› ‹nx s-p'→⇘ret⇙ nx' ∨ (∃V. nx s-p':V→⇘out⇙ nx')›
‹nx' is-nsx'→⇩d* n'›
show ?thesis by fastforce
qed
qed
qed
lemma irs_SDG_path_matched:
assumes "n irs-ns→⇩d* n''" and "n'' s-p→⇘ret⇙ n' ∨ n'' s-p:V→⇘out⇙ n'"
obtains nx nsx where "matched nx nsx n'" and "n ∈ set nsx"
and "nx s-p→⇘sum⇙ CFG_node (parent_node n')"
proof(atomize_elim)
from assms
show "∃nx nsx. matched nx nsx n' ∧ n ∈ set nsx ∧
nx s-p→⇘sum⇙ CFG_node (parent_node n')"
proof(induct ns arbitrary:n'' n' p V rule:length_induct)
fix ns n'' n' p V
assume IH:"∀ns'. length ns' < length ns ⟶
(∀n''. n irs-ns'→⇩d* n'' ⟶
(∀nx' p' V'. (n'' s-p'→⇘ret⇙ nx' ∨ n'' s-p':V'→⇘out⇙ nx') ⟶
(∃nx nsx. matched nx nsx nx' ∧ n ∈ set nsx ∧
nx s-p'→⇘sum⇙ CFG_node (parent_node nx'))))"
and "n irs-ns→⇩d* n''" and "n'' s-p→⇘ret⇙ n' ∨ n'' s-p:V→⇘out⇙ n'"
from ‹n'' s-p→⇘ret⇙ n' ∨ n'' s-p:V→⇘out⇙ n'› have "valid_SDG_node n''"
by(fastforce intro:sum_SDG_edge_valid_SDG_node)
from ‹n'' s-p→⇘ret⇙ n' ∨ n'' s-p:V→⇘out⇙ n'›
have "n'' -p→⇘ret⇙ n' ∨ n'' -p:V→⇘out⇙ n'"
by(fastforce intro:sum_SDG_edge_SDG_edge SDG_edge_sum_SDG_edge)
from ‹n'' s-p→⇘ret⇙ n' ∨ n'' s-p:V→⇘out⇙ n'›
have "CFG_node (parent_node n'') s-p→⇘ret⇙ CFG_node (parent_node n')"
by(fastforce elim:sum_SDG_edge.cases intro:sum_SDG_return_edge)
then obtain a Q f where "valid_edge a" and "kind a = Q↩⇘p⇙f"
and "parent_node n'' = sourcenode a" and "parent_node n' = targetnode a"
by(fastforce elim:sum_SDG_edge.cases)
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f› obtain a' Q' r' fs'
where "a ∈ get_return_edges a'" and "valid_edge a'" and "kind a' = Q':r'↪⇘p⇙fs'"
and "CFG_node (sourcenode a') s-p→⇘sum⇙ CFG_node (targetnode a)"
by(erule return_edge_determines_call_and_sum_edge)
from ‹valid_edge a'› ‹kind a' = Q':r'↪⇘p⇙fs'›
have "CFG_node (sourcenode a') s-p→⇘call⇙ CFG_node (targetnode a')"
by(fastforce intro:sum_SDG_call_edge)
from ‹CFG_node (parent_node n'') s-p→⇘ret⇙ CFG_node (parent_node n')›
have "get_proc (parent_node n'') = p"
by(auto elim!:sum_SDG_edge.cases intro:get_proc_return)
from ‹n irs-ns→⇩d* n''›
show "∃nx nsx. matched nx nsx n' ∧ n ∈ set nsx ∧
nx s-p→⇘sum⇙ CFG_node (parent_node n')"
proof(rule irs_SDG_path_split)
assume "n is-ns→⇩d* n''"
hence "valid_SDG_node n" by(rule is_SDG_path_valid_SDG_node)
then obtain asx where "(_Entry_) -asx→⇩√* parent_node n"
by(fastforce dest:valid_SDG_CFG_node Entry_path)
then obtain asx' where "(_Entry_) -asx'→⇩√* parent_node n"
and "∀a' ∈ set asx'. intra_kind(kind a') ∨ (∃Q r p fs. kind a' = Q:r↪⇘p⇙fs)"
by -(erule valid_Entry_path_ascending_path)
from ‹n is-ns→⇩d* n''› obtain as where "parent_node n -as→⇩ι* parent_node n''"
by(erule is_SDG_path_CFG_path)
hence "get_proc (parent_node n) = get_proc (parent_node n'')"
by(rule intra_path_get_procs)
from ‹valid_SDG_node n› have "valid_node (parent_node n)"
by(rule valid_SDG_CFG_node)
hence "valid_SDG_node (CFG_node (parent_node n))" by simp
have "∃a as. valid_edge a ∧ (∃Q p r fs. kind a = Q:r↪⇘p⇙fs) ∧
targetnode a -as→⇩ι* parent_node n"
proof(cases "∀a' ∈ set asx'. intra_kind(kind a')")
case True
with ‹(_Entry_) -asx'→⇩√* parent_node n›
have "(_Entry_) -asx'→⇩ι* parent_node n"
by(fastforce simp:intra_path_def vp_def)
hence "get_proc (_Entry_) = get_proc (parent_node n)"
by(rule intra_path_get_procs)
with get_proc_Entry have "get_proc (parent_node n) = Main" by simp
from ‹get_proc (parent_node n) = get_proc (parent_node n'')›
‹get_proc (parent_node n) = Main›
have "get_proc (parent_node n'') = Main" by simp
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f› have "get_proc (sourcenode a) = p"
by(rule get_proc_return)
with ‹parent_node n'' = sourcenode a› ‹get_proc (parent_node n'') = Main›
have "p = Main" by simp
with ‹kind a = Q↩⇘p⇙f› have "kind a = Q↩⇘Main⇙f" by simp
with ‹valid_edge a› have False by(rule Main_no_return_source)
thus ?thesis by simp
next
assume "¬ (∀a'∈set asx'. intra_kind (kind a'))"
with ‹∀a' ∈ set asx'. intra_kind(kind a') ∨ (∃Q r p fs. kind a' = Q:r↪⇘p⇙fs)›
have "∃a' ∈ set asx'. ∃Q r p fs. kind a' = Q:r↪⇘p⇙fs"
by(fastforce simp:intra_kind_def)
then obtain as a' as' where "asx' = as@a'#as'"
and "∃Q r p fs. kind a' = Q:r↪⇘p⇙fs"
and "∀a' ∈ set as'. ¬ (∃Q r p fs. kind a' = Q:r↪⇘p⇙fs)"
by(erule split_list_last_propE)
with ‹∀a' ∈ set asx'. intra_kind(kind a') ∨ (∃Q r p fs. kind a' = Q:r↪⇘p⇙fs)›
have "∀a'∈set as'. intra_kind (kind a')" by(auto simp:intra_kind_def)
from ‹(_Entry_) -asx'→⇩√* parent_node n› ‹asx' = as@a'#as'›
have "valid_edge a'" and "targetnode a' -as'→* parent_node n"
by(auto dest:path_split simp:vp_def)
with ‹∀a'∈set as'. intra_kind (kind a')› ‹∃Q r p fs. kind a' = Q:r↪⇘p⇙fs›
show ?thesis by(fastforce simp:intra_path_def)
qed
then obtain ax asx Qx rx fsx px where "valid_edge ax"
and "kind ax = Qx:rx↪⇘px⇙fsx" and "targetnode ax -asx→⇩ι* parent_node n"
by blast
from ‹valid_edge ax› ‹kind ax = Qx:rx↪⇘px⇙fsx›
have "get_proc (targetnode ax) = px"
by(rule get_proc_call)
from ‹targetnode ax -asx→⇩ι* parent_node n›
have "get_proc (targetnode ax) = get_proc (parent_node n)"
by(rule intra_path_get_procs)
with ‹get_proc (parent_node n) = get_proc (parent_node n'')›
‹get_proc (targetnode ax) = px›
have "get_proc (parent_node n'') = px" by simp
with ‹get_proc (parent_node n'') = p› have [simp]:"px = p" by simp
from ‹valid_edge a'› ‹valid_edge ax› ‹kind a' = Q':r'↪⇘p⇙fs'›
‹kind ax = Qx:rx↪⇘px⇙fsx›
have "targetnode a' = targetnode ax" by simp(rule same_proc_call_unique_target)
have "parent_node n ≠ (_Exit_)"
proof
assume "parent_node n = (_Exit_)"
from ‹n is-ns→⇩d* n''› obtain as where "parent_node n -as→⇩ι* parent_node n''"
by(erule is_SDG_path_CFG_path)
with ‹parent_node n = (_Exit_)›
have "(_Exit_) -as→* parent_node n''" by(simp add:intra_path_def)
hence "parent_node n'' = (_Exit_)" by(fastforce dest:path_Exit_source)
from ‹get_proc (parent_node n'') = p› ‹parent_node n'' = (_Exit_)›
‹parent_node n'' = sourcenode a› get_proc_Exit
have "p = Main" by simp
with ‹kind a = Q↩⇘p⇙f› have "kind a = Q↩⇘Main⇙f" by simp
with ‹valid_edge a› show False by(rule Main_no_return_source)
qed
have "∃nsx. CFG_node (targetnode a') cd-nsx→⇩d* CFG_node (parent_node n)"
proof(cases "targetnode a' = parent_node n")
case True
with ‹valid_SDG_node (CFG_node (parent_node n))›
have "CFG_node (targetnode a') cd-[]→⇩d* CFG_node (parent_node n)"
by(fastforce intro:cdSp_Nil)
thus ?thesis by blast
next
case False
with ‹targetnode ax -asx→⇩ι* parent_node n› ‹parent_node n ≠ (_Exit_)›
‹valid_edge ax› ‹kind ax = Qx:rx↪⇘px⇙fsx› ‹targetnode a' = targetnode ax›
obtain nsx
where "CFG_node (targetnode a') cd-nsx→⇩d* CFG_node (parent_node n)"
by(fastforce elim!:in_proc_cdep_SDG_path)
thus ?thesis by blast
qed
then obtain nsx
where "CFG_node (targetnode a') cd-nsx→⇩d* CFG_node (parent_node n)" by blast
hence "CFG_node (targetnode a') i-nsx→⇩d* CFG_node (parent_node n)"
by(rule cdep_SDG_path_intra_SDG_path)
show ?thesis
proof(cases ns)
case Nil
with ‹n is-ns→⇩d* n''› have "n = n''"
by(fastforce elim:intra_sum_SDG_path.cases)
from ‹valid_edge a'› ‹kind a' = Q':r'↪⇘p⇙fs'› ‹a ∈ get_return_edges a'›
have "matched (CFG_node (targetnode a')) [CFG_node (targetnode a')]
(CFG_node (sourcenode a))" by(rule intra_proc_matched)
from ‹valid_SDG_node n''›
have "n'' = CFG_node (parent_node n'') ∨ CFG_node (parent_node n'') ⟶⇘cd⇙ n''"
by(rule valid_SDG_node_cases)
hence "∃nsx. CFG_node (parent_node n'') i-nsx→⇩d* n''"
proof
assume "n'' = CFG_node (parent_node n'')"
with ‹valid_SDG_node n''› have "CFG_node (parent_node n'') i-[]→⇩d* n''"
by(fastforce intro:iSp_Nil)
thus ?thesis by blast
next
assume "CFG_node (parent_node n'') ⟶⇘cd⇙ n''"
from ‹valid_SDG_node n''› have "valid_node (parent_node n'')"
by(rule valid_SDG_CFG_node)
hence "valid_SDG_node (CFG_node (parent_node n''))" by simp
hence "CFG_node (parent_node n'') i-[]→⇩d* CFG_node (parent_node n'')"
by(rule iSp_Nil)
with ‹CFG_node (parent_node n'') ⟶⇘cd⇙ n''›
have "CFG_node (parent_node n'') i-[]@[CFG_node (parent_node n'')]→⇩d* n''"
by(fastforce intro:iSp_Append_cdep sum_SDG_edge_SDG_edge)
thus ?thesis by blast
qed
with ‹parent_node n'' = sourcenode a›
obtain nsx where "CFG_node (sourcenode a) i-nsx→⇩d* n''" by fastforce
with ‹matched (CFG_node (targetnode a')) [CFG_node (targetnode a')]
(CFG_node (sourcenode a))›
have "matched (CFG_node (targetnode a')) ([CFG_node (targetnode a')]@nsx) n''"
by(fastforce intro:matched_Append intra_SDG_path_matched)
moreover
from ‹valid_edge a'› ‹kind a' = Q':r'↪⇘p⇙fs'›
have "CFG_node (sourcenode a') -p→⇘call⇙ CFG_node (targetnode a')"
by(fastforce intro:SDG_call_edge)
moreover
from ‹valid_edge a'› have "valid_SDG_node (CFG_node (sourcenode a'))"
by simp
hence "matched (CFG_node (sourcenode a')) [] (CFG_node (sourcenode a'))"
by(rule matched_Nil)
ultimately have "matched (CFG_node (sourcenode a'))
([]@(CFG_node (sourcenode a'))#([CFG_node (targetnode a')]@nsx)@[n'']) n'"
using ‹n'' s-p→⇘ret⇙ n' ∨ n'' s-p:V→⇘out⇙ n'› ‹parent_node n' = targetnode a›
‹parent_node n'' = sourcenode a› ‹valid_edge a'› ‹a ∈ get_return_edges a'›
by(fastforce intro:matched_bracket_call dest:sum_SDG_edge_SDG_edge)
with ‹n = n''› ‹CFG_node (sourcenode a') s-p→⇘sum⇙ CFG_node (targetnode a)›
‹parent_node n' = targetnode a›
show ?thesis by fastforce
next
case Cons
with ‹n is-ns→⇩d* n''› have "n ∈ set ns"
by(induct rule:intra_sum_SDG_path_rev_induct) auto
from ‹n is-ns→⇩d* n''› obtain ns' where "matched n ns' n''"
and "set ns ⊆ set ns'" by(erule is_SDG_path_matched)
with ‹n ∈ set ns› have "n ∈ set ns'" by fastforce
from ‹valid_SDG_node n›
have "n = CFG_node (parent_node n) ∨ CFG_node (parent_node n) ⟶⇘cd⇙ n"
by(rule valid_SDG_node_cases)
hence "∃nsx. CFG_node (parent_node n) i-nsx→⇩d* n"
proof
assume "n = CFG_node (parent_node n)"
with ‹valid_SDG_node n› have "CFG_node (parent_node n) i-[]→⇩d* n"
by(fastforce intro:iSp_Nil)
thus ?thesis by blast
next
assume "CFG_node (parent_node n) ⟶⇘cd⇙ n"
from ‹valid_SDG_node (CFG_node (parent_node n))›
have "CFG_node (parent_node n) i-[]→⇩d* CFG_node (parent_node n)"
by(rule iSp_Nil)
with ‹CFG_node (parent_node n) ⟶⇘cd⇙ n›
have "CFG_node (parent_node n) i-[]@[CFG_node (parent_node n)]→⇩d* n"
by(fastforce intro:iSp_Append_cdep sum_SDG_edge_SDG_edge)
thus ?thesis by blast
qed
then obtain nsx' where "CFG_node (parent_node n) i-nsx'→⇩d* n" by blast
with ‹CFG_node (targetnode a') i-nsx→⇩d* CFG_node (parent_node n)›
have "CFG_node (targetnode a') i-nsx@nsx'→⇩d* n"
by -(rule intra_SDG_path_Append)
hence "matched (CFG_node (targetnode a')) (nsx@nsx') n"
by(rule intra_SDG_path_matched)
with ‹matched n ns' n''›
have "matched (CFG_node (targetnode a')) ((nsx@nsx')@ns') n''"
by(rule matched_Append)
moreover
from ‹valid_edge a'› ‹kind a' = Q':r'↪⇘p⇙fs'›
have "CFG_node (sourcenode a') -p→⇘call⇙ CFG_node (targetnode a')"
by(fastforce intro:SDG_call_edge)
moreover
from ‹valid_edge a'› have "valid_SDG_node (CFG_node (sourcenode a'))"
by simp
hence "matched (CFG_node (sourcenode a')) [] (CFG_node (sourcenode a'))"
by(rule matched_Nil)
ultimately have "matched (CFG_node (sourcenode a'))
([]@(CFG_node (sourcenode a'))#((nsx@nsx')@ns')@[n'']) n'"
using ‹n'' s-p→⇘ret⇙ n' ∨ n'' s-p:V→⇘out⇙ n'› ‹parent_node n' = targetnode a›
‹parent_node n'' = sourcenode a› ‹valid_edge a'› ‹a ∈ get_return_edges a'›
by(fastforce intro:matched_bracket_call dest:sum_SDG_edge_SDG_edge)
with ‹CFG_node (sourcenode a') s-p→⇘sum⇙ CFG_node (targetnode a)›
‹parent_node n' = targetnode a› ‹n ∈ set ns'›
show ?thesis by fastforce
qed
next
fix ms ms' m m' px
assume "ns = ms@m#ms'" and "n irs-ms→⇩d* m"
and "m s-px→⇘ret⇙ m' ∨ (∃V. m s-px:V→⇘out⇙ m')" and "m' is-ms'→⇩d* n''"
from ‹ns = ms@m#ms'› have "length ms < length ns" by simp
with IH ‹n irs-ms→⇩d* m› ‹m s-px→⇘ret⇙ m' ∨ (∃V. m s-px:V→⇘out⇙ m')› obtain mx msx
where "matched mx msx m'" and "n ∈ set msx"
and "mx s-px→⇘sum⇙ CFG_node (parent_node m')" by fastforce
from ‹m' is-ms'→⇩d* n''› obtain msx' where "matched m' msx' n''"
by -(erule is_SDG_path_matched)
with ‹matched mx msx m'› have "matched mx (msx@msx') n''"
by -(rule matched_Append)
from ‹m s-px→⇘ret⇙ m' ∨ (∃V. m s-px:V→⇘out⇙ m')›
have "m -px→⇘ret⇙ m' ∨ (∃V. m -px:V→⇘out⇙ m')"
by(auto intro:sum_SDG_edge_SDG_edge SDG_edge_sum_SDG_edge)
from ‹m s-px→⇘ret⇙ m' ∨ (∃V. m s-px:V→⇘out⇙ m')›
have "CFG_node (parent_node m) s-px→⇘ret⇙ CFG_node (parent_node m')"
by(fastforce elim:sum_SDG_edge.cases intro:sum_SDG_return_edge)
then obtain ax Qx fx where "valid_edge ax" and "kind ax = Qx↩⇘px⇙fx"
and "parent_node m = sourcenode ax" and "parent_node m' = targetnode ax"
by(fastforce elim:sum_SDG_edge.cases)
from ‹valid_edge ax› ‹kind ax = Qx↩⇘px⇙fx› obtain ax' Qx' rx' fsx'
where "ax ∈ get_return_edges ax'" and "valid_edge ax'"
and "kind ax' = Qx':rx'↪⇘px⇙fsx'"
and "CFG_node (sourcenode ax') s-px→⇘sum⇙ CFG_node (targetnode ax)"
by(erule return_edge_determines_call_and_sum_edge)
from ‹valid_edge ax'› ‹kind ax' = Qx':rx'↪⇘px⇙fsx'›
have "CFG_node (sourcenode ax') s-px→⇘call⇙ CFG_node (targetnode ax')"
by(fastforce intro:sum_SDG_call_edge)
from ‹mx s-px→⇘sum⇙ CFG_node (parent_node m')›
have "valid_SDG_node mx" by(rule sum_SDG_edge_valid_SDG_node)
have "∃msx''. CFG_node (targetnode a') cd-msx''→⇩d* mx"
proof(cases "targetnode a' = parent_node mx")
case True
from ‹valid_SDG_node mx›
have "mx = CFG_node (parent_node mx) ∨ CFG_node (parent_node mx) ⟶⇘cd⇙ mx"
by(rule valid_SDG_node_cases)
thus ?thesis
proof
assume "mx = CFG_node (parent_node mx)"
with ‹valid_SDG_node mx› True
have "CFG_node (targetnode a') cd-[]→⇩d* mx" by(fastforce intro:cdSp_Nil)
thus ?thesis by blast
next
assume "CFG_node (parent_node mx) ⟶⇘cd⇙ mx"
with ‹valid_edge a'› True[THEN sym]
have "CFG_node (targetnode a') cd-[]@[CFG_node (targetnode a')]→⇩d* mx"
by(fastforce intro:cdep_SDG_path.intros)
thus ?thesis by blast
qed
next
case False
show ?thesis
proof(cases "∀ai. valid_edge ai ∧ sourcenode ai = parent_node mx
⟶ ai ∉ get_return_edges a'")
case True
{ assume "parent_node mx = (_Exit_)"
with ‹mx s-px→⇘sum⇙ CFG_node (parent_node m')›
obtain ai where "valid_edge ai" and "sourcenode ai = (_Exit_)"
by -(erule sum_SDG_edge.cases,auto)
hence False by(rule Exit_source) }
hence "parent_node mx ≠ (_Exit_)" by fastforce
from ‹valid_SDG_node mx› have "valid_node (parent_node mx)"
by(rule valid_SDG_CFG_node)
then obtain asx where "(_Entry_) -asx→⇩√* parent_node mx"
by(fastforce intro:Entry_path)
then obtain asx' where "(_Entry_) -asx'→⇩√* parent_node mx"
and "∀a' ∈ set asx'. intra_kind(kind a') ∨ (∃Q r p fs. kind a' = Q:r↪⇘p⇙fs)"
by -(erule valid_Entry_path_ascending_path)
from ‹mx s-px→⇘sum⇙ CFG_node (parent_node m')›
obtain nsi where "matched mx nsi (CFG_node (parent_node m'))"
by -(erule sum_SDG_summary_edge_matched)
then obtain asi where "parent_node mx -asi→⇘sl⇙* parent_node m'"
by(fastforce elim:matched_same_level_CFG_path)
hence "get_proc (parent_node mx) = get_proc (parent_node m')"
by(rule slp_get_proc)
from ‹m' is-ms'→⇩d* n''› obtain nsi' where "matched m' nsi' n''"
by -(erule is_SDG_path_matched)
then obtain asi' where "parent_node m' -asi'→⇘sl⇙* parent_node n''"
by -(erule matched_same_level_CFG_path)
hence "get_proc (parent_node m') = get_proc (parent_node n'')"
by(rule slp_get_proc)
with ‹get_proc (parent_node mx) = get_proc (parent_node m')›
have "get_proc (parent_node mx) = get_proc (parent_node n'')" by simp
from ‹get_proc (parent_node n'') = p›
‹get_proc (parent_node mx) = get_proc (parent_node n'')›
have "get_proc (parent_node mx) = p" by simp
have "∃asx. targetnode a' -asx→⇩ι* parent_node mx"
proof(cases "∀a' ∈ set asx'. intra_kind(kind a')")
case True
with ‹(_Entry_) -asx'→⇩√* parent_node mx›
have "(_Entry_) -asx'→⇩ι* parent_node mx"
by(simp add:vp_def intra_path_def)
hence "get_proc (_Entry_) = get_proc (parent_node mx)"
by(rule intra_path_get_procs)
with ‹get_proc (parent_node mx) = p› have "get_proc (_Entry_) = p"
by simp
with ‹CFG_node (parent_node n'') s-p→⇘ret⇙ CFG_node (parent_node n')›
have False
by -(erule sum_SDG_edge.cases,
auto intro:Main_no_return_source simp:get_proc_Entry)
thus ?thesis by simp
next
case False
hence "∃a' ∈ set asx'. ¬ intra_kind (kind a')" by fastforce
then obtain ai as' as'' where "asx' = as'@ai#as''"
and "¬ intra_kind (kind ai)" and "∀a' ∈ set as''. intra_kind (kind a')"
by(fastforce elim!:split_list_last_propE)
from ‹asx' = as'@ai#as''› ‹¬ intra_kind (kind ai)›
‹∀a' ∈ set asx'. intra_kind(kind a') ∨ (∃Q r p fs. kind a' = Q:r↪⇘p⇙fs)›
obtain Qi ri pi fsi where "kind ai = Qi:ri↪⇘pi⇙fsi"
and "∀a' ∈ set as'. intra_kind(kind a') ∨
(∃Q r p fs. kind a' = Q:r↪⇘p⇙fs)"
by auto
from ‹(_Entry_) -asx'→⇩√* parent_node mx› ‹asx' = as'@ai#as''›
‹∀a' ∈ set as''. intra_kind (kind a')›
have "valid_edge ai" and "targetnode ai -as''→⇩ι* parent_node mx"
by(auto intro:path_split simp:vp_def intra_path_def)
hence "get_proc (targetnode ai) = get_proc (parent_node mx)"
by -(rule intra_path_get_procs)
with ‹get_proc (parent_node mx) = p› ‹valid_edge ai›
‹kind ai = Qi:ri↪⇘pi⇙fsi›
have [simp]:"pi = p" by(fastforce dest:get_proc_call)
from ‹valid_edge ai› ‹valid_edge a'›
‹kind ai = Qi:ri↪⇘pi⇙fsi› ‹kind a' = Q':r'↪⇘p⇙fs'›
have "targetnode ai = targetnode a'"
by(fastforce intro:same_proc_call_unique_target)
with ‹targetnode ai -as''→⇩ι* parent_node mx›
show ?thesis by fastforce
qed
then obtain asx where "targetnode a' -asx→⇩ι* parent_node mx" by blast
from this ‹valid_edge a'› ‹kind a' = Q':r'↪⇘p⇙fs'›
‹parent_node mx ≠ (_Exit_)› ‹targetnode a' ≠ parent_node mx› True
obtain msi
where "CFG_node(targetnode a') cd-msi→⇩d* CFG_node(parent_node mx)"
by(fastforce elim!:in_proc_cdep_SDG_path)
from ‹valid_SDG_node mx›
have "mx = CFG_node (parent_node mx) ∨ CFG_node (parent_node mx) ⟶⇘cd⇙ mx"
by(rule valid_SDG_node_cases)
thus ?thesis
proof
assume "mx = CFG_node (parent_node mx)"
with ‹CFG_node(targetnode a')cd-msi→⇩d* CFG_node(parent_node mx)›
show ?thesis by fastforce
next
assume "CFG_node (parent_node mx) ⟶⇘cd⇙ mx"
with ‹CFG_node(targetnode a')cd-msi→⇩d* CFG_node(parent_node mx)›
have "CFG_node(targetnode a') cd-msi@[CFG_node(parent_node mx)]→⇩d* mx"
by(fastforce intro:cdSp_Append_cdep)
thus ?thesis by fastforce
qed
next
case False
then obtain ai where "valid_edge ai" and "sourcenode ai = parent_node mx"
and "ai ∈ get_return_edges a'" by blast
with ‹valid_edge a'› ‹kind a' = Q':r'↪⇘p⇙fs'›
have "CFG_node (targetnode a') ⟶⇘cd⇙ CFG_node (parent_node mx)"
by(auto intro:SDG_proc_entry_exit_cdep)
with ‹valid_edge a'›
have cd_path:"CFG_node (targetnode a') cd-[]@[CFG_node (targetnode a')]→⇩d*
CFG_node (parent_node mx)"
by(fastforce intro:cdSp_Append_cdep cdSp_Nil)
from ‹valid_SDG_node mx›
have "mx = CFG_node (parent_node mx) ∨ CFG_node (parent_node mx) ⟶⇘cd⇙ mx"
by(rule valid_SDG_node_cases)
thus ?thesis
proof
assume "mx = CFG_node (parent_node mx)"
with cd_path show ?thesis by fastforce
next
assume "CFG_node (parent_node mx) ⟶⇘cd⇙ mx"
with cd_path have "CFG_node (targetnode a')
cd-[CFG_node (targetnode a')]@[CFG_node (parent_node mx)]→⇩d* mx"
by(fastforce intro:cdSp_Append_cdep)
thus ?thesis by fastforce
qed
qed
qed
then obtain msx''
where "CFG_node (targetnode a') cd-msx''→⇩d* mx" by blast
hence "CFG_node (targetnode a') i-msx''→⇩d* mx"
by(rule cdep_SDG_path_intra_SDG_path)
with ‹valid_edge a'›
have "matched (CFG_node (targetnode a')) ([]@msx'') mx"
by(fastforce intro:matched_Append_intra_SDG_path matched_Nil)
with ‹matched mx (msx@msx') n''›
have "matched (CFG_node (targetnode a')) (msx''@(msx@msx')) n''"
by(fastforce intro:matched_Append)
with ‹valid_edge a'› ‹CFG_node (sourcenode a') s-p→⇘call⇙ CFG_node (targetnode a')›
‹n'' -p→⇘ret⇙ n' ∨ n'' -p:V→⇘out⇙ n'› ‹a ∈ get_return_edges a'›
‹parent_node n'' = sourcenode a› ‹parent_node n' = targetnode a›
have "matched (CFG_node (sourcenode a'))
([]@CFG_node (sourcenode a')#(msx''@(msx@msx'))@[n'']) n'"
by(fastforce intro:matched_bracket_call matched_Nil sum_SDG_edge_SDG_edge)
with ‹n ∈ set msx› ‹CFG_node (sourcenode a') s-p→⇘sum⇙ CFG_node (targetnode a)›
‹parent_node n' = targetnode a›
show ?thesis by fastforce
qed
qed
qed
lemma irs_SDG_path_realizable:
assumes "n irs-ns→⇩d* n'" and "n ≠ n'"
obtains ns' where "realizable (CFG_node (_Entry_)) ns' n'" and "n ∈ set ns'"
proof(atomize_elim)
from ‹n irs-ns→⇩d* n'›
have "n = n' ∨ (∃ns'. realizable (CFG_node (_Entry_)) ns' n' ∧ n ∈ set ns')"
proof(rule irs_SDG_path_split)
assume "n is-ns→⇩d* n'"
show ?thesis
proof(cases "ns = []")
case True
with ‹n is-ns→⇩d* n'› have "n = n'" by(fastforce elim:intra_sum_SDG_path.cases)
thus ?thesis by simp
next
case False
with ‹n is-ns→⇩d* n'› have "n ∈ set ns" by(fastforce dest:is_SDG_path_hd)
from ‹n is-ns→⇩d* n'› have "valid_SDG_node n" and "valid_SDG_node n'"
by(rule is_SDG_path_valid_SDG_node)+
hence "valid_node (parent_node n)" by -(rule valid_SDG_CFG_node)
from ‹n is-ns→⇩d* n'› obtain ns' where "matched n ns' n'" and "set ns ⊆ set ns'"
by(erule is_SDG_path_matched)
with ‹n ∈ set ns› have "n ∈ set ns'" by fastforce
from ‹valid_node (parent_node n)›
show ?thesis
proof(cases "parent_node n = (_Exit_)")
case True
with ‹valid_SDG_node n› have "n = CFG_node (_Exit_)"
by(rule valid_SDG_node_parent_Exit)
from ‹n is-ns→⇩d* n'› obtain as where "parent_node n -as→⇩ι* parent_node n'"
by -(erule is_SDG_path_intra_CFG_path)
with ‹n = CFG_node (_Exit_)› have "parent_node n' = (_Exit_)"
by(fastforce dest:path_Exit_source simp:intra_path_def)
with ‹valid_SDG_node n'› have "n' = CFG_node (_Exit_)"
by(rule valid_SDG_node_parent_Exit)
with ‹n = CFG_node (_Exit_)› show ?thesis by simp
next
case False
with ‹valid_SDG_node n›
obtain nsx where "CFG_node (_Entry_) cc-nsx→⇩d* n"
by(erule Entry_cc_SDG_path_to_inner_node)
hence "realizable (CFG_node (_Entry_)) nsx n"
by(rule cdep_SDG_path_realizable)
with ‹matched n ns' n'›
have "realizable (CFG_node (_Entry_)) (nsx@ns') n'"
by -(rule realizable_Append_matched)
with ‹n ∈ set ns'› show ?thesis by fastforce
qed
qed
next
fix nsx nsx' nx nx' p
assume "ns = nsx@nx#nsx'" and "n irs-nsx→⇩d* nx"
and "nx s-p→⇘ret⇙ nx' ∨ (∃V. nx s-p:V→⇘out⇙ nx')" and "nx' is-nsx'→⇩d* n'"
from ‹nx s-p→⇘ret⇙ nx' ∨ (∃V. nx s-p:V→⇘out⇙ nx')›
have "CFG_node (parent_node nx) s-p→⇘ret⇙ CFG_node (parent_node nx')"
by(fastforce elim:sum_SDG_edge.cases intro:sum_SDG_return_edge)
then obtain a Q f where "valid_edge a" and "kind a = Q↩⇘p⇙f"
and "parent_node nx = sourcenode a" and "parent_node nx' = targetnode a"
by(fastforce elim:sum_SDG_edge.cases)
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f› obtain a' Q' r' fs'
where "a ∈ get_return_edges a'" and "valid_edge a'" and "kind a' = Q':r'↪⇘p⇙fs'"
and "CFG_node (sourcenode a') s-p→⇘sum⇙ CFG_node (targetnode a)"
by(erule return_edge_determines_call_and_sum_edge)
from ‹valid_edge a'› ‹kind a' = Q':r'↪⇘p⇙fs'›
have "CFG_node (sourcenode a') s-p→⇘call⇙ CFG_node (targetnode a')"
by(fastforce intro:sum_SDG_call_edge)
from ‹n irs-nsx→⇩d* nx› ‹nx s-p→⇘ret⇙ nx' ∨ (∃V. nx s-p:V→⇘out⇙ nx')›
obtain m ms where "matched m ms nx'" and "n ∈ set ms"
and "m s-p→⇘sum⇙ CFG_node (parent_node nx')"
by(fastforce elim:irs_SDG_path_matched)
from ‹nx' is-nsx'→⇩d* n'› obtain ms' where "matched nx' ms' n'"
and "set nsx' ⊆ set ms'" by(erule is_SDG_path_matched)
with ‹matched m ms nx'› have "matched m (ms@ms') n'" by -(rule matched_Append)
from ‹m s-p→⇘sum⇙ CFG_node (parent_node nx')› have "valid_SDG_node m"
by(rule sum_SDG_edge_valid_SDG_node)
hence "valid_node (parent_node m)" by(rule valid_SDG_CFG_node)
thus ?thesis
proof(cases "parent_node m = (_Exit_)")
case True
from ‹m s-p→⇘sum⇙ CFG_node (parent_node nx')› obtain a where "valid_edge a"
and "sourcenode a = parent_node m"
by(fastforce elim:sum_SDG_edge.cases)
with True have False by -(rule Exit_source,simp_all)
thus ?thesis by simp
next
case False
with ‹valid_SDG_node m›
obtain ms'' where "CFG_node (_Entry_) cc-ms''→⇩d* m"
by(erule Entry_cc_SDG_path_to_inner_node)
hence "realizable (CFG_node (_Entry_)) ms'' m"
by(rule cdep_SDG_path_realizable)
with ‹matched m (ms@ms') n'›
have "realizable (CFG_node (_Entry_)) (ms''@(ms@ms')) n'"
by -(rule realizable_Append_matched)
with ‹n ∈ set ms› show ?thesis by fastforce
qed
qed
with ‹n ≠ n'› show "∃ns'. realizable (CFG_node (_Entry_)) ns' n' ∧ n ∈ set ns'"
by simp
qed
end
end
Theory HRBSlice
section ‹Horwitz-Reps-Binkley Slice›
theory HRBSlice imports SDG begin
context SDG begin
subsection ‹Set describing phase 1 of the two-phase slicer›
inductive_set sum_SDG_slice1 :: "'node SDG_node ⇒ 'node SDG_node set"
for n::"'node SDG_node"
where refl_slice1:"valid_SDG_node n ⟹ n ∈ sum_SDG_slice1 n"
| cdep_slice1:
"⟦n'' s⟶⇘cd⇙ n'; n' ∈ sum_SDG_slice1 n⟧ ⟹ n'' ∈ sum_SDG_slice1 n"
| ddep_slice1:
"⟦n'' s-V→⇩d⇩d n'; n' ∈ sum_SDG_slice1 n⟧ ⟹ n'' ∈ sum_SDG_slice1 n"
| call_slice1:
"⟦n'' s-p→⇘call⇙ n'; n' ∈ sum_SDG_slice1 n⟧ ⟹ n'' ∈ sum_SDG_slice1 n"
| param_in_slice1:
"⟦n'' s-p:V→⇘in⇙ n'; n' ∈ sum_SDG_slice1 n⟧ ⟹ n'' ∈ sum_SDG_slice1 n"
| sum_slice1:
"⟦n'' s-p→⇘sum⇙ n'; n' ∈ sum_SDG_slice1 n⟧ ⟹ n'' ∈ sum_SDG_slice1 n"
lemma slice1_cdep_slice1:
"⟦nx ∈ sum_SDG_slice1 n; n s⟶⇘cd⇙ n'⟧ ⟹ nx ∈ sum_SDG_slice1 n'"
by(induct rule:sum_SDG_slice1.induct,
auto intro:sum_SDG_slice1.intros sum_SDG_edge_valid_SDG_node)
lemma slice1_ddep_slice1:
"⟦nx ∈ sum_SDG_slice1 n; n s-V→⇩d⇩d n'⟧ ⟹ nx ∈ sum_SDG_slice1 n'"
by(induct rule:sum_SDG_slice1.induct,
auto intro:sum_SDG_slice1.intros sum_SDG_edge_valid_SDG_node)
lemma slice1_sum_slice1:
"⟦nx ∈ sum_SDG_slice1 n; n s-p→⇘sum⇙ n'⟧ ⟹ nx ∈ sum_SDG_slice1 n'"
by(induct rule:sum_SDG_slice1.induct,
auto intro:sum_SDG_slice1.intros sum_SDG_edge_valid_SDG_node)
lemma slice1_call_slice1:
"⟦nx ∈ sum_SDG_slice1 n; n s-p→⇘call⇙ n'⟧ ⟹ nx ∈ sum_SDG_slice1 n'"
by(induct rule:sum_SDG_slice1.induct,
auto intro:sum_SDG_slice1.intros sum_SDG_edge_valid_SDG_node)
lemma slice1_param_in_slice1:
"⟦nx ∈ sum_SDG_slice1 n; n s-p:V→⇘in⇙ n'⟧ ⟹ nx ∈ sum_SDG_slice1 n'"
by(induct rule:sum_SDG_slice1.induct,
auto intro:sum_SDG_slice1.intros sum_SDG_edge_valid_SDG_node)
lemma is_SDG_path_slice1:
"⟦n is-ns→⇩d* n'; n' ∈ sum_SDG_slice1 n''⟧ ⟹ n ∈ sum_SDG_slice1 n''"
proof(induct rule:intra_sum_SDG_path.induct)
case isSp_Nil thus ?case by simp
next
case (isSp_Append_cdep n ns nx n')
note IH = ‹nx ∈ sum_SDG_slice1 n'' ⟹ n ∈ sum_SDG_slice1 n''›
from ‹nx s⟶⇘cd⇙ n'› ‹n' ∈ sum_SDG_slice1 n''›
have "nx ∈ sum_SDG_slice1 n''" by(rule cdep_slice1)
from IH[OF this] show ?case .
next
case (isSp_Append_ddep n ns nx V n')
note IH = ‹nx ∈ sum_SDG_slice1 n'' ⟹ n ∈ sum_SDG_slice1 n''›
from ‹nx s-V→⇩d⇩d n'› ‹n' ∈ sum_SDG_slice1 n''›
have "nx ∈ sum_SDG_slice1 n''" by(rule ddep_slice1)
from IH[OF this] show ?case .
next
case (isSp_Append_sum n ns nx p n')
note IH = ‹nx ∈ sum_SDG_slice1 n'' ⟹ n ∈ sum_SDG_slice1 n''›
from ‹nx s-p→⇘sum⇙ n'› ‹n' ∈ sum_SDG_slice1 n''›
have "nx ∈ sum_SDG_slice1 n''" by(rule sum_slice1)
from IH[OF this] show ?case .
qed
subsection ‹Set describing phase 2 of the two-phase slicer›
inductive_set sum_SDG_slice2 :: "'node SDG_node ⇒ 'node SDG_node set"
for n::"'node SDG_node"
where refl_slice2:"valid_SDG_node n ⟹ n ∈ sum_SDG_slice2 n"
| cdep_slice2:
"⟦n'' s⟶⇘cd⇙ n'; n' ∈ sum_SDG_slice2 n⟧ ⟹ n'' ∈ sum_SDG_slice2 n"
| ddep_slice2:
"⟦n'' s-V→⇩d⇩d n'; n' ∈ sum_SDG_slice2 n⟧ ⟹ n'' ∈ sum_SDG_slice2 n"
| return_slice2:
"⟦n'' s-p→⇘ret⇙ n'; n' ∈ sum_SDG_slice2 n⟧ ⟹ n'' ∈ sum_SDG_slice2 n"
| param_out_slice2:
"⟦n'' s-p:V→⇘out⇙ n'; n' ∈ sum_SDG_slice2 n⟧ ⟹ n'' ∈ sum_SDG_slice2 n"
| sum_slice2:
"⟦n'' s-p→⇘sum⇙ n'; n' ∈ sum_SDG_slice2 n⟧ ⟹ n'' ∈ sum_SDG_slice2 n"
lemma slice2_cdep_slice2:
"⟦nx ∈ sum_SDG_slice2 n; n s⟶⇘cd⇙ n'⟧ ⟹ nx ∈ sum_SDG_slice2 n'"
by(induct rule:sum_SDG_slice2.induct,
auto intro:sum_SDG_slice2.intros sum_SDG_edge_valid_SDG_node)
lemma slice2_ddep_slice2:
"⟦nx ∈ sum_SDG_slice2 n; n s-V→⇩d⇩d n'⟧ ⟹ nx ∈ sum_SDG_slice2 n'"
by(induct rule:sum_SDG_slice2.induct,
auto intro:sum_SDG_slice2.intros sum_SDG_edge_valid_SDG_node)
lemma slice2_sum_slice2:
"⟦nx ∈ sum_SDG_slice2 n; n s-p→⇘sum⇙ n'⟧ ⟹ nx ∈ sum_SDG_slice2 n'"
by(induct rule:sum_SDG_slice2.induct,
auto intro:sum_SDG_slice2.intros sum_SDG_edge_valid_SDG_node)
lemma slice2_ret_slice2:
"⟦nx ∈ sum_SDG_slice2 n; n s-p→⇘ret⇙ n'⟧ ⟹ nx ∈ sum_SDG_slice2 n'"
by(induct rule:sum_SDG_slice2.induct,
auto intro:sum_SDG_slice2.intros sum_SDG_edge_valid_SDG_node)
lemma slice2_param_out_slice2:
"⟦nx ∈ sum_SDG_slice2 n; n s-p:V→⇘out⇙ n'⟧ ⟹ nx ∈ sum_SDG_slice2 n'"
by(induct rule:sum_SDG_slice2.induct,
auto intro:sum_SDG_slice2.intros sum_SDG_edge_valid_SDG_node)
lemma is_SDG_path_slice2:
"⟦n is-ns→⇩d* n'; n' ∈ sum_SDG_slice2 n''⟧ ⟹ n ∈ sum_SDG_slice2 n''"
proof(induct rule:intra_sum_SDG_path.induct)
case isSp_Nil thus ?case by simp
next
case (isSp_Append_cdep n ns nx n')
note IH = ‹nx ∈ sum_SDG_slice2 n'' ⟹ n ∈ sum_SDG_slice2 n''›
from ‹nx s⟶⇘cd⇙ n'› ‹n' ∈ sum_SDG_slice2 n''›
have "nx ∈ sum_SDG_slice2 n''" by(rule cdep_slice2)
from IH[OF this] show ?case .
next
case (isSp_Append_ddep n ns nx V n')
note IH = ‹nx ∈ sum_SDG_slice2 n'' ⟹ n ∈ sum_SDG_slice2 n''›
from ‹nx s-V→⇩d⇩d n'› ‹n' ∈ sum_SDG_slice2 n''›
have "nx ∈ sum_SDG_slice2 n''" by(rule ddep_slice2)
from IH[OF this] show ?case .
next
case (isSp_Append_sum n ns nx p n')
note IH = ‹nx ∈ sum_SDG_slice2 n'' ⟹ n ∈ sum_SDG_slice2 n''›
from ‹nx s-p→⇘sum⇙ n'› ‹n' ∈ sum_SDG_slice2 n''›
have "nx ∈ sum_SDG_slice2 n''" by(rule sum_slice2)
from IH[OF this] show ?case .
qed
lemma slice2_is_SDG_path_slice2:
"⟦n is-ns→⇩d* n'; n'' ∈ sum_SDG_slice2 n⟧ ⟹ n'' ∈ sum_SDG_slice2 n'"
proof(induct rule:intra_sum_SDG_path.induct)
case isSp_Nil thus ?case by simp
next
case (isSp_Append_cdep n ns nx n')
from ‹n'' ∈ sum_SDG_slice2 n ⟹ n'' ∈ sum_SDG_slice2 nx› ‹n'' ∈ sum_SDG_slice2 n›
have "n'' ∈ sum_SDG_slice2 nx" .
with ‹nx s⟶⇘cd⇙ n'› show ?case by -(rule slice2_cdep_slice2)
next
case (isSp_Append_ddep n ns nx V n')
from ‹n'' ∈ sum_SDG_slice2 n ⟹ n'' ∈ sum_SDG_slice2 nx› ‹n'' ∈ sum_SDG_slice2 n›
have "n'' ∈ sum_SDG_slice2 nx" .
with ‹nx s-V→⇩d⇩d n'› show ?case by -(rule slice2_ddep_slice2)
next
case (isSp_Append_sum n ns nx p n')
from ‹n'' ∈ sum_SDG_slice2 n ⟹ n'' ∈ sum_SDG_slice2 nx› ‹n'' ∈ sum_SDG_slice2 n›
have "n'' ∈ sum_SDG_slice2 nx" .
with ‹nx s-p→⇘sum⇙ n'› show ?case by -(rule slice2_sum_slice2)
qed
subsection ‹The backward slice using the Horwitz-Reps-Binkley slicer›
text ‹Note: our slicing criterion is a set of nodes, not a unique node.›
inductive_set combine_SDG_slices :: "'node SDG_node set ⇒ 'node SDG_node set"
for S::"'node SDG_node set"
where combSlice_refl:"n ∈ S ⟹ n ∈ combine_SDG_slices S"
| combSlice_Return_parent_node:
"⟦n' ∈ S; n'' s-p→⇘ret⇙ CFG_node (parent_node n'); n ∈ sum_SDG_slice2 n'⟧
⟹ n ∈ combine_SDG_slices S"
definition HRB_slice :: "'node SDG_node set ⇒ 'node SDG_node set"
where "HRB_slice S ≡ {n'. ∃n ∈ S. n' ∈ combine_SDG_slices (sum_SDG_slice1 n)}"
lemma HRB_slice_cases[consumes 1,case_names phase1 phase2]:
"⟦x ∈ HRB_slice S; ⋀n nx. ⟦n ∈ sum_SDG_slice1 nx; nx ∈ S⟧ ⟹ P n;
⋀nx n' n'' p n. ⟦n' ∈ sum_SDG_slice1 nx; n'' s-p→⇘ret⇙ CFG_node (parent_node n');
n ∈ sum_SDG_slice2 n'; nx ∈ S⟧ ⟹ P n⟧
⟹ P x"
by(fastforce elim:combine_SDG_slices.cases simp:HRB_slice_def)
lemma HRB_slice_refl:
assumes "valid_node m" and "CFG_node m ∈ S" shows "CFG_node m ∈ HRB_slice S"
proof -
from ‹valid_node m› have "CFG_node m ∈ sum_SDG_slice1 (CFG_node m)"
by(fastforce intro:refl_slice1)
with ‹CFG_node m ∈ S› show ?thesis
by(simp add:HRB_slice_def)(blast intro:combSlice_refl)
qed
lemma HRB_slice_valid_node: "n ∈ HRB_slice S ⟹ valid_SDG_node n"
proof(induct rule:HRB_slice_cases)
case (phase1 n nx) thus ?case
by(induct rule:sum_SDG_slice1.induct,auto intro:sum_SDG_edge_valid_SDG_node)
next
case (phase2 nx n' n'' p n)
from ‹n ∈ sum_SDG_slice2 n'›
show ?case
by(induct rule:sum_SDG_slice2.induct,auto intro:sum_SDG_edge_valid_SDG_node)
qed
lemma valid_SDG_node_in_slice_parent_node_in_slice:
assumes "n ∈ HRB_slice S" shows "CFG_node (parent_node n) ∈ HRB_slice S"
proof -
from ‹n ∈ HRB_slice S› have "valid_SDG_node n" by(rule HRB_slice_valid_node)
hence "n = CFG_node (parent_node n) ∨ CFG_node (parent_node n) ⟶⇘cd⇙ n"
by(rule valid_SDG_node_cases)
thus ?thesis
proof
assume "n = CFG_node (parent_node n)"
with ‹n ∈ HRB_slice S› show ?thesis by simp
next
assume "CFG_node (parent_node n) ⟶⇘cd⇙ n"
hence "CFG_node (parent_node n) s⟶⇘cd⇙ n" by(rule SDG_edge_sum_SDG_edge)
with ‹n ∈ HRB_slice S› show ?thesis
by(fastforce elim:combine_SDG_slices.cases
intro:combine_SDG_slices.intros cdep_slice1 cdep_slice2
simp:HRB_slice_def)
qed
qed
lemma HRB_slice_is_SDG_path_HRB_slice:
"⟦n is-ns→⇩d* n'; n'' ∈ HRB_slice {n}; n' ∈ S⟧ ⟹ n'' ∈ HRB_slice S"
proof(induct arbitrary:S rule:intra_sum_SDG_path.induct)
case (isSp_Nil n) thus ?case by(fastforce simp:HRB_slice_def)
next
case (isSp_Append_cdep n ns nx n')
note IH = ‹⋀S. ⟦n'' ∈ HRB_slice {n}; nx ∈ S⟧ ⟹ n'' ∈ HRB_slice S›
from IH[OF ‹n'' ∈ HRB_slice {n}›] have "n'' ∈ HRB_slice {nx}" by simp
thus ?case
proof(induct rule:HRB_slice_cases)
case (phase1 n nx')
from ‹nx' ∈ {nx}› have "nx' = nx" by simp
with ‹n ∈ sum_SDG_slice1 nx'› ‹nx s⟶⇘cd⇙ n'› have "n ∈ sum_SDG_slice1 n'"
by(fastforce intro:slice1_cdep_slice1)
with ‹n' ∈ S› show ?case
by(fastforce intro:combine_SDG_slices.combSlice_refl simp:HRB_slice_def)
next
case (phase2 nx'' nx' n'' p n)
from ‹nx'' ∈ {nx}› have "nx'' = nx" by simp
with ‹nx' ∈ sum_SDG_slice1 nx''› ‹nx s⟶⇘cd⇙ n'› have "nx' ∈ sum_SDG_slice1 n'"
by(fastforce intro:slice1_cdep_slice1)
with ‹n'' s-p→⇘ret⇙ CFG_node (parent_node nx')› ‹n ∈ sum_SDG_slice2 nx'› ‹n' ∈ S›
show ?case by(fastforce intro:combine_SDG_slices.combSlice_Return_parent_node
simp:HRB_slice_def)
qed
next
case (isSp_Append_ddep n ns nx V n')
note IH = ‹⋀S. ⟦n'' ∈ HRB_slice {n}; nx ∈ S⟧ ⟹ n'' ∈ HRB_slice S›
from IH[OF ‹n'' ∈ HRB_slice {n}›] have "n'' ∈ HRB_slice {nx}" by simp
thus ?case
proof(induct rule:HRB_slice_cases)
case (phase1 n nx')
from ‹nx' ∈ {nx}› have "nx' = nx" by simp
with ‹n ∈ sum_SDG_slice1 nx'› ‹nx s-V→⇩d⇩d n'› have "n ∈ sum_SDG_slice1 n'"
by(fastforce intro:slice1_ddep_slice1)
with ‹n' ∈ S› show ?case
by(fastforce intro:combine_SDG_slices.combSlice_refl simp:HRB_slice_def)
next
case (phase2 nx'' nx' n'' p n)
from ‹nx'' ∈ {nx}› have "nx'' = nx" by simp
with ‹nx' ∈ sum_SDG_slice1 nx''› ‹nx s-V→⇩d⇩d n'› have "nx' ∈ sum_SDG_slice1 n'"
by(fastforce intro:slice1_ddep_slice1)
with ‹n'' s-p→⇘ret⇙ CFG_node (parent_node nx')› ‹n ∈ sum_SDG_slice2 nx'› ‹n' ∈ S›
show ?case by(fastforce intro:combine_SDG_slices.combSlice_Return_parent_node
simp:HRB_slice_def)
qed
next
case (isSp_Append_sum n ns nx p n')
note IH = ‹⋀S. ⟦n'' ∈ HRB_slice {n}; nx ∈ S⟧ ⟹ n'' ∈ HRB_slice S›
from IH[OF ‹n'' ∈ HRB_slice {n}›] have "n'' ∈ HRB_slice {nx}" by simp
thus ?case
proof(induct rule:HRB_slice_cases)
case (phase1 n nx')
from ‹nx' ∈ {nx}› have "nx' = nx" by simp
with ‹n ∈ sum_SDG_slice1 nx'› ‹nx s-p→⇘sum⇙ n'› have "n ∈ sum_SDG_slice1 n'"
by(fastforce intro:slice1_sum_slice1)
with ‹n' ∈ S› show ?case
by(fastforce intro:combine_SDG_slices.combSlice_refl simp:HRB_slice_def)
next
case (phase2 nx'' nx' n'' p' n)
from ‹nx'' ∈ {nx}› have "nx'' = nx" by simp
with ‹nx' ∈ sum_SDG_slice1 nx''› ‹nx s-p→⇘sum⇙ n'› have "nx' ∈ sum_SDG_slice1 n'"
by(fastforce intro:slice1_sum_slice1)
with ‹n'' s-p'→⇘ret⇙ CFG_node (parent_node nx')› ‹n ∈ sum_SDG_slice2 nx'› ‹n' ∈ S›
show ?case by(fastforce intro:combine_SDG_slices.combSlice_Return_parent_node
simp:HRB_slice_def)
qed
qed
lemma call_return_nodes_in_slice:
assumes "valid_edge a" and "kind a = Q↩⇘p⇙f"
and "valid_edge a'" and "kind a' = Q':r'↪⇘p⇙fs'" and "a ∈ get_return_edges a'"
and "CFG_node (targetnode a) ∈ HRB_slice S"
shows "CFG_node (sourcenode a) ∈ HRB_slice S"
and "CFG_node (sourcenode a') ∈ HRB_slice S"
and "CFG_node (targetnode a') ∈ HRB_slice S"
proof -
from ‹valid_edge a'› ‹kind a' = Q':r'↪⇘p⇙fs'› ‹a ∈ get_return_edges a'›
have "CFG_node (sourcenode a') s-p→⇘sum⇙ CFG_node (targetnode a)"
by(fastforce intro:sum_SDG_call_summary_edge)
with ‹CFG_node (targetnode a) ∈ HRB_slice S›
show "CFG_node (sourcenode a') ∈ HRB_slice S"
by(fastforce elim!:combine_SDG_slices.cases
intro:combine_SDG_slices.intros sum_slice1 sum_slice2
simp:HRB_slice_def)
from ‹CFG_node (targetnode a) ∈ HRB_slice S›
obtain n⇩c where "CFG_node (targetnode a) ∈ combine_SDG_slices (sum_SDG_slice1 n⇩c)"
and "n⇩c ∈ S"
by(simp add:HRB_slice_def) blast
thus "CFG_node (sourcenode a) ∈ HRB_slice S"
proof(induct "CFG_node (targetnode a)" rule:combine_SDG_slices.induct)
case combSlice_refl
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f›
have "CFG_node (sourcenode a) s-p→⇘ret⇙ CFG_node (targetnode a)"
by(fastforce intro:sum_SDG_return_edge)
with ‹valid_edge a›
have "CFG_node (sourcenode a) ∈ sum_SDG_slice2 (CFG_node (targetnode a))"
by(fastforce intro:sum_SDG_slice2.intros)
with ‹CFG_node (targetnode a) ∈ sum_SDG_slice1 n⇩c› ‹n⇩c ∈ S›
‹CFG_node (sourcenode a) s-p→⇘ret⇙ CFG_node (targetnode a)›
show ?case by(fastforce intro:combSlice_Return_parent_node simp:HRB_slice_def)
next
case (combSlice_Return_parent_node n' n'' p')
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f›
have "CFG_node (sourcenode a) s-p→⇘ret⇙ CFG_node (targetnode a)"
by(fastforce intro:sum_SDG_return_edge)
with ‹CFG_node (targetnode a) ∈ sum_SDG_slice2 n'›
have "CFG_node (sourcenode a) ∈ sum_SDG_slice2 n'"
by(fastforce intro:sum_SDG_slice2.intros)
with ‹n' ∈ sum_SDG_slice1 n⇩c› ‹n'' s-p'→⇘ret⇙ CFG_node (parent_node n')› ‹n⇩c ∈ S›
show ?case by(fastforce intro:combine_SDG_slices.combSlice_Return_parent_node
simp:HRB_slice_def)
qed
from ‹valid_edge a'› ‹kind a' = Q':r'↪⇘p⇙fs'› ‹a ∈ get_return_edges a'›
have "CFG_node (targetnode a') s⟶⇘cd⇙ CFG_node (sourcenode a)"
by(fastforce intro:sum_SDG_proc_entry_exit_cdep)
with ‹CFG_node (sourcenode a) ∈ HRB_slice S› ‹n⇩c ∈ S›
show "CFG_node (targetnode a') ∈ HRB_slice S"
by(fastforce elim!:combine_SDG_slices.cases
intro:combine_SDG_slices.intros cdep_slice1 cdep_slice2
simp:HRB_slice_def)
qed
subsection ‹Proof of Precision›
lemma in_intra_SDG_path_in_slice2:
"⟦n i-ns→⇩d* n'; n'' ∈ set ns⟧ ⟹ n'' ∈ sum_SDG_slice2 n'"
proof(induct rule:intra_SDG_path.induct)
case iSp_Nil thus ?case by simp
next
case (iSp_Append_cdep n ns nx n')
note IH = ‹n'' ∈ set ns ⟹ n'' ∈ sum_SDG_slice2 nx›
from ‹n'' ∈ set (ns@[nx])› have "n'' ∈ set ns ∨ n'' = nx" by auto
thus ?case
proof
assume "n'' ∈ set ns"
from IH[OF this] have "n'' ∈ sum_SDG_slice2 nx" by simp
with ‹nx ⟶⇘cd⇙ n'› show ?thesis
by(fastforce intro:slice2_cdep_slice2 SDG_edge_sum_SDG_edge)
next
assume "n'' = nx"
from ‹nx ⟶⇘cd⇙ n'› have "valid_SDG_node n'" by(rule SDG_edge_valid_SDG_node)
hence "n' ∈ sum_SDG_slice2 n'" by(rule refl_slice2)
with ‹nx ⟶⇘cd⇙ n'› have "nx ∈ sum_SDG_slice2 n'"
by(fastforce intro:cdep_slice2 SDG_edge_sum_SDG_edge)
with ‹n'' = nx› show ?thesis by simp
qed
next
case (iSp_Append_ddep n ns nx V n')
note IH = ‹n'' ∈ set ns ⟹ n'' ∈ sum_SDG_slice2 nx›
from ‹n'' ∈ set (ns@[nx])› have "n'' ∈ set ns ∨ n'' = nx" by auto
thus ?case
proof
assume "n'' ∈ set ns"
from IH[OF this] have "n'' ∈ sum_SDG_slice2 nx" by simp
with ‹nx -V→⇩d⇩d n'› show ?thesis
by(fastforce intro:slice2_ddep_slice2 SDG_edge_sum_SDG_edge)
next
assume "n'' = nx"
from ‹nx -V→⇩d⇩d n'› have "valid_SDG_node n'" by(rule SDG_edge_valid_SDG_node)
hence "n' ∈ sum_SDG_slice2 n'" by(rule refl_slice2)
with ‹nx -V→⇩d⇩d n'› have "nx ∈ sum_SDG_slice2 n'"
by(fastforce intro:ddep_slice2 SDG_edge_sum_SDG_edge)
with ‹n'' = nx› show ?thesis by simp
qed
qed
lemma in_intra_SDG_path_in_HRB_slice:
"⟦n i-ns→⇩d* n'; n'' ∈ set ns; n' ∈ S⟧ ⟹ n'' ∈ HRB_slice S"
proof(induct arbitrary:S rule:intra_SDG_path.induct)
case iSp_Nil thus ?case by simp
next
case (iSp_Append_cdep n ns nx n')
note IH = ‹⋀S. ⟦n'' ∈ set ns; nx ∈ S⟧ ⟹ n'' ∈ HRB_slice S›
from ‹n'' ∈ set (ns@[nx])› have "n'' ∈ set ns ∨ n'' = nx" by auto
thus ?case
proof
assume "n'' ∈ set ns"
from IH[OF ‹n'' ∈ set ns›] have "n'' ∈ HRB_slice {nx}" by simp
from this ‹nx ⟶⇘cd⇙ n'› ‹n' ∈ S› show ?case
by(fastforce elim:HRB_slice_cases slice1_cdep_slice1
intro:bexI[where x="n'"] combine_SDG_slices.intros SDG_edge_sum_SDG_edge
simp:HRB_slice_def)
next
assume "n'' = nx"
from ‹nx ⟶⇘cd⇙ n'› have "valid_SDG_node n'" by(rule SDG_edge_valid_SDG_node)
hence "n' ∈ sum_SDG_slice1 n'" by(rule refl_slice1)
with ‹nx ⟶⇘cd⇙ n'› have "nx ∈ sum_SDG_slice1 n'"
by(fastforce intro:cdep_slice1 SDG_edge_sum_SDG_edge)
with ‹n'' = nx› ‹n' ∈ S› show ?case
by(fastforce intro:combSlice_refl simp:HRB_slice_def)
qed
next
case (iSp_Append_ddep n ns nx V n')
note IH = ‹⋀S. ⟦n'' ∈ set ns; nx ∈ S⟧ ⟹ n'' ∈ HRB_slice S›
from ‹n'' ∈ set (ns@[nx])› have "n'' ∈ set ns ∨ n'' = nx" by auto
thus ?case
proof
assume "n'' ∈ set ns"
from IH[OF ‹n'' ∈ set ns›] have "n'' ∈ HRB_slice {nx}" by simp
from this ‹nx -V→⇩d⇩d n'› ‹n' ∈ S› show ?case
by(fastforce elim:HRB_slice_cases slice1_ddep_slice1
intro:bexI[where x="n'"] combine_SDG_slices.intros SDG_edge_sum_SDG_edge
simp:HRB_slice_def)
next
assume "n'' = nx"
from ‹nx -V→⇩d⇩d n'› have "valid_SDG_node n'" by(rule SDG_edge_valid_SDG_node)
hence "n' ∈ sum_SDG_slice1 n'" by(rule refl_slice1)
with ‹nx -V→⇩d⇩d n'› have "nx ∈ sum_SDG_slice1 n'"
by(fastforce intro:ddep_slice1 SDG_edge_sum_SDG_edge)
with ‹n'' = nx› ‹n' ∈ S› show ?case
by(fastforce intro:combSlice_refl simp:HRB_slice_def)
qed
qed
lemma in_matched_in_slice2:
"⟦matched n ns n'; n'' ∈ set ns⟧ ⟹ n'' ∈ sum_SDG_slice2 n'"
proof(induct rule:matched.induct)
case matched_Nil thus ?case by simp
next
case (matched_Append_intra_SDG_path n ns nx ns' n')
note IH = ‹n'' ∈ set ns ⟹ n'' ∈ sum_SDG_slice2 nx›
from ‹n'' ∈ set (ns@ns')› have "n'' ∈ set ns ∨ n'' ∈ set ns'" by simp
thus ?case
proof
assume "n'' ∈ set ns"
from IH[OF this] have "n'' ∈ sum_SDG_slice2 nx" .
with ‹nx i-ns'→⇩d* n'› show ?thesis
by(fastforce intro:slice2_is_SDG_path_slice2
intra_SDG_path_is_SDG_path)
next
assume "n'' ∈ set ns'"
with ‹nx i-ns'→⇩d* n'› show ?case by(rule in_intra_SDG_path_in_slice2)
qed
next
case (matched_bracket_call n⇩0 ns n⇩1 p n⇩2 ns' n⇩3 n⇩4 V a a')
note IH1 = ‹n'' ∈ set ns ⟹ n'' ∈ sum_SDG_slice2 n⇩1›
note IH2 = ‹n'' ∈ set ns' ⟹ n'' ∈ sum_SDG_slice2 n⇩3›
from ‹n⇩1 -p→⇘call⇙ n⇩2› ‹matched n⇩2 ns' n⇩3› ‹n⇩3 -p→⇘ret⇙ n⇩4 ∨ n⇩3 -p:V→⇘out⇙ n⇩4›
‹a' ∈ get_return_edges a› ‹valid_edge a›
‹sourcenode a = parent_node n⇩1› ‹targetnode a = parent_node n⇩2›
‹sourcenode a' = parent_node n⇩3› ‹targetnode a' = parent_node n⇩4›
have "matched n⇩1 ([]@n⇩1#ns'@[n⇩3]) n⇩4"
by(fastforce intro:matched.matched_bracket_call matched_Nil
elim:SDG_edge_valid_SDG_node)
then obtain nsx where "n⇩1 is-nsx→⇩d* n⇩4" by(erule matched_is_SDG_path)
from ‹n'' ∈ set (ns@n⇩1#ns'@[n⇩3])›
have "((n'' ∈ set ns ∨ n'' = n⇩1) ∨ n'' ∈ set ns') ∨ n'' = n⇩3" by auto
thus ?case apply -
proof(erule disjE)+
assume "n'' ∈ set ns"
from IH1[OF this] have "n'' ∈ sum_SDG_slice2 n⇩1" .
with ‹n⇩1 is-nsx→⇩d* n⇩4› show ?thesis
by -(rule slice2_is_SDG_path_slice2)
next
assume "n'' = n⇩1"
from ‹n⇩1 is-nsx→⇩d* n⇩4› have "n⇩1 ∈ sum_SDG_slice2 n⇩4"
by(fastforce intro:is_SDG_path_slice2 refl_slice2 is_SDG_path_valid_SDG_node)
with ‹n'' = n⇩1› show ?thesis by(fastforce intro:combSlice_refl simp:HRB_slice_def)
next
assume "n'' ∈ set ns'"
from IH2[OF this] have "n'' ∈ sum_SDG_slice2 n⇩3" .
with ‹n⇩3 -p→⇘ret⇙ n⇩4 ∨ n⇩3 -p:V→⇘out⇙ n⇩4› show ?thesis
by(fastforce intro:slice2_ret_slice2 slice2_param_out_slice2
SDG_edge_sum_SDG_edge)
next
assume "n'' = n⇩3"
from ‹n⇩3 -p→⇘ret⇙ n⇩4 ∨ n⇩3 -p:V→⇘out⇙ n⇩4› have "n⇩3 s-p→⇘ret⇙ n⇩4 ∨ n⇩3 s-p:V→⇘out⇙ n⇩4"
by(fastforce intro:SDG_edge_sum_SDG_edge)
hence "n⇩3 ∈ sum_SDG_slice2 n⇩4"
by(fastforce intro:return_slice2 param_out_slice2 refl_slice2
sum_SDG_edge_valid_SDG_node)
with ‹n'' = n⇩3› show ?thesis by simp
qed
next
case (matched_bracket_param n⇩0 ns n⇩1 p V n⇩2 ns' n⇩3 V' n⇩4 a a')
note IH1 = ‹n'' ∈ set ns ⟹ n'' ∈ sum_SDG_slice2 n⇩1›
note IH2 = ‹n'' ∈ set ns' ⟹ n'' ∈ sum_SDG_slice2 n⇩3›
from ‹n⇩1 -p:V→⇘in⇙ n⇩2› ‹matched n⇩2 ns' n⇩3› ‹n⇩3 -p:V'→⇘out⇙ n⇩4›
‹a' ∈ get_return_edges a› ‹valid_edge a›
‹sourcenode a = parent_node n⇩1› ‹targetnode a = parent_node n⇩2›
‹sourcenode a' = parent_node n⇩3› ‹targetnode a' = parent_node n⇩4›
have "matched n⇩1 ([]@n⇩1#ns'@[n⇩3]) n⇩4"
by(fastforce intro:matched.matched_bracket_param matched_Nil
elim:SDG_edge_valid_SDG_node)
then obtain nsx where "n⇩1 is-nsx→⇩d* n⇩4" by(erule matched_is_SDG_path)
from ‹n'' ∈ set (ns@n⇩1#ns'@[n⇩3])›
have "((n'' ∈ set ns ∨ n'' = n⇩1) ∨ n'' ∈ set ns') ∨ n'' = n⇩3" by auto
thus ?case apply -
proof(erule disjE)+
assume "n'' ∈ set ns"
from IH1[OF this] have "n'' ∈ sum_SDG_slice2 n⇩1" .
with ‹n⇩1 is-nsx→⇩d* n⇩4› show ?thesis
by -(rule slice2_is_SDG_path_slice2)
next
assume "n'' = n⇩1"
from ‹n⇩1 is-nsx→⇩d* n⇩4› have "n⇩1 ∈ sum_SDG_slice2 n⇩4"
by(fastforce intro:is_SDG_path_slice2 refl_slice2 is_SDG_path_valid_SDG_node)
with ‹n'' = n⇩1› show ?thesis by(fastforce intro:combSlice_refl simp:HRB_slice_def)
next
assume "n'' ∈ set ns'"
from IH2[OF this] have "n'' ∈ sum_SDG_slice2 n⇩3" .
with ‹n⇩3 -p:V'→⇘out⇙ n⇩4› show ?thesis
by(fastforce intro:slice2_param_out_slice2 SDG_edge_sum_SDG_edge)
next
assume "n'' = n⇩3"
from ‹n⇩3 -p:V'→⇘out⇙ n⇩4› have "n⇩3 s-p:V'→⇘out⇙ n⇩4" by(rule SDG_edge_sum_SDG_edge)
hence "n⇩3 ∈ sum_SDG_slice2 n⇩4"
by(fastforce intro:param_out_slice2 refl_slice2 sum_SDG_edge_valid_SDG_node)
with ‹n'' = n⇩3› show ?thesis by simp
qed
qed
lemma in_matched_in_HRB_slice:
"⟦matched n ns n'; n'' ∈ set ns; n' ∈ S⟧ ⟹ n'' ∈ HRB_slice S"
proof(induct arbitrary:S rule:matched.induct)
case matched_Nil thus ?case by simp
next
case (matched_Append_intra_SDG_path n ns nx ns' n')
note IH = ‹⋀S. ⟦n'' ∈ set ns; nx ∈ S⟧ ⟹ n'' ∈ HRB_slice S›
from ‹n'' ∈ set (ns@ns')› have "n'' ∈ set ns ∨ n'' ∈ set ns'" by simp
thus ?case
proof
assume "n'' ∈ set ns"
from IH[OF ‹n'' ∈ set ns›] have "n'' ∈ HRB_slice {nx}" by simp
with ‹nx i-ns'→⇩d* n'› ‹n' ∈ S› show ?thesis
by(fastforce intro:HRB_slice_is_SDG_path_HRB_slice
intra_SDG_path_is_SDG_path)
next
assume "n'' ∈ set ns'"
with ‹nx i-ns'→⇩d* n'› ‹n' ∈ S› show ?case
by(fastforce intro:in_intra_SDG_path_in_HRB_slice simp:HRB_slice_def)
qed
next
case (matched_bracket_call n⇩0 ns n⇩1 p n⇩2 ns' n⇩3 n⇩4 V a a')
note IH1 = ‹⋀S. ⟦n'' ∈ set ns; n⇩1 ∈ S⟧ ⟹ n'' ∈ HRB_slice S›
note IH2 = ‹⋀S. ⟦n'' ∈ set ns'; n⇩3 ∈ S⟧ ⟹ n'' ∈ HRB_slice S›
from ‹n⇩1 -p→⇘call⇙ n⇩2› ‹matched n⇩2 ns' n⇩3› ‹n⇩3 -p→⇘ret⇙ n⇩4 ∨ n⇩3 -p:V→⇘out⇙ n⇩4›
‹a' ∈ get_return_edges a› ‹valid_edge a›
‹sourcenode a = parent_node n⇩1› ‹targetnode a = parent_node n⇩2›
‹sourcenode a' = parent_node n⇩3› ‹targetnode a' = parent_node n⇩4›
have "matched n⇩1 ([]@n⇩1#ns'@[n⇩3]) n⇩4"
by(fastforce intro:matched.matched_bracket_call matched_Nil
elim:SDG_edge_valid_SDG_node)
then obtain nsx where "n⇩1 is-nsx→⇩d* n⇩4" by(erule matched_is_SDG_path)
from ‹n'' ∈ set (ns@n⇩1#ns'@[n⇩3])›
have "((n'' ∈ set ns ∨ n'' = n⇩1) ∨ n'' ∈ set ns') ∨ n'' = n⇩3" by auto
thus ?case apply -
proof(erule disjE)+
assume "n'' ∈ set ns"
from IH1[OF this] have "n'' ∈ HRB_slice {n⇩1}" by simp
with ‹n⇩1 is-nsx→⇩d* n⇩4› ‹n⇩4 ∈ S› show ?thesis
by -(rule HRB_slice_is_SDG_path_HRB_slice)
next
assume "n'' = n⇩1"
from ‹n⇩1 is-nsx→⇩d* n⇩4› have "n⇩1 ∈ sum_SDG_slice1 n⇩4"
by(fastforce intro:is_SDG_path_slice1 refl_slice1 is_SDG_path_valid_SDG_node)
with ‹n'' = n⇩1› ‹n⇩4 ∈ S› show ?thesis
by(fastforce intro:combSlice_refl simp:HRB_slice_def)
next
assume "n'' ∈ set ns'"
with ‹matched n⇩2 ns' n⇩3› have "n'' ∈ sum_SDG_slice2 n⇩3"
by(rule in_matched_in_slice2)
with ‹n⇩3 -p→⇘ret⇙ n⇩4 ∨ n⇩3 -p:V→⇘out⇙ n⇩4› have "n'' ∈ sum_SDG_slice2 n⇩4"
by(fastforce intro:slice2_ret_slice2 slice2_param_out_slice2
SDG_edge_sum_SDG_edge)
from ‹n⇩3 -p→⇘ret⇙ n⇩4 ∨ n⇩3 -p:V→⇘out⇙ n⇩4› have "valid_SDG_node n⇩4"
by(fastforce intro:SDG_edge_valid_SDG_node)
hence "n⇩4 ∈ sum_SDG_slice1 n⇩4" by(rule refl_slice1)
from ‹n⇩3 -p→⇘ret⇙ n⇩4 ∨ n⇩3 -p:V→⇘out⇙ n⇩4›
have "CFG_node (parent_node n⇩3) -p→⇘ret⇙ CFG_node (parent_node n⇩4)"
by(fastforce elim:SDG_edge.cases intro:SDG_return_edge)
with ‹n'' ∈ sum_SDG_slice2 n⇩4› ‹n⇩4 ∈ sum_SDG_slice1 n⇩4› ‹n⇩4 ∈ S›
show ?case by(fastforce intro:combSlice_Return_parent_node SDG_edge_sum_SDG_edge
simp:HRB_slice_def)
next
assume "n'' = n⇩3"
from ‹n⇩3 -p→⇘ret⇙ n⇩4 ∨ n⇩3 -p:V→⇘out⇙ n⇩4›
have "CFG_node (parent_node n⇩3) -p→⇘ret⇙ CFG_node (parent_node n⇩4)"
by(fastforce elim:SDG_edge.cases intro:SDG_return_edge)
from ‹n⇩3 -p→⇘ret⇙ n⇩4 ∨ n⇩3 -p:V→⇘out⇙ n⇩4› have "valid_SDG_node n⇩4"
by(fastforce intro:SDG_edge_valid_SDG_node)
hence "n⇩4 ∈ sum_SDG_slice1 n⇩4" by(rule refl_slice1)
from ‹valid_SDG_node n⇩4› have "n⇩4 ∈ sum_SDG_slice2 n⇩4" by(rule refl_slice2)
with ‹n⇩3 -p→⇘ret⇙ n⇩4 ∨ n⇩3 -p:V→⇘out⇙ n⇩4› have "n⇩3 ∈ sum_SDG_slice2 n⇩4"
by(fastforce intro:return_slice2 param_out_slice2 SDG_edge_sum_SDG_edge)
with ‹n⇩4 ∈ sum_SDG_slice1 n⇩4›
‹CFG_node (parent_node n⇩3) -p→⇘ret⇙ CFG_node (parent_node n⇩4)› ‹n'' = n⇩3› ‹n⇩4 ∈ S›
show ?case by(fastforce intro:combSlice_Return_parent_node SDG_edge_sum_SDG_edge
simp:HRB_slice_def)
qed
next
case (matched_bracket_param n⇩0 ns n⇩1 p V n⇩2 ns' n⇩3 V' n⇩4 a a')
note IH1 = ‹⋀S. ⟦n'' ∈ set ns; n⇩1 ∈ S⟧ ⟹ n'' ∈ HRB_slice S›
note IH2 = ‹⋀S. ⟦n'' ∈ set ns'; n⇩3 ∈ S⟧ ⟹ n'' ∈ HRB_slice S›
from ‹n⇩1 -p:V→⇘in⇙ n⇩2› ‹matched n⇩2 ns' n⇩3› ‹n⇩3 -p:V'→⇘out⇙ n⇩4›
‹a' ∈ get_return_edges a› ‹valid_edge a›
‹sourcenode a = parent_node n⇩1› ‹targetnode a = parent_node n⇩2›
‹sourcenode a' = parent_node n⇩3› ‹targetnode a' = parent_node n⇩4›
have "matched n⇩1 ([]@n⇩1#ns'@[n⇩3]) n⇩4"
by(fastforce intro:matched.matched_bracket_param matched_Nil
elim:SDG_edge_valid_SDG_node)
then obtain nsx where "n⇩1 is-nsx→⇩d* n⇩4" by(erule matched_is_SDG_path)
from ‹n'' ∈ set (ns@n⇩1#ns'@[n⇩3])›
have "((n'' ∈ set ns ∨ n'' = n⇩1) ∨ n'' ∈ set ns') ∨ n'' = n⇩3" by auto
thus ?case apply -
proof(erule disjE)+
assume "n'' ∈ set ns"
from IH1[OF this] have "n'' ∈ HRB_slice {n⇩1}" by simp
with ‹n⇩1 is-nsx→⇩d* n⇩4› ‹n⇩4 ∈ S› show ?thesis
by -(rule HRB_slice_is_SDG_path_HRB_slice)
next
assume "n'' = n⇩1"
from ‹n⇩1 is-nsx→⇩d* n⇩4› have "n⇩1 ∈ sum_SDG_slice1 n⇩4"
by(fastforce intro:is_SDG_path_slice1 refl_slice1 is_SDG_path_valid_SDG_node)
with ‹n'' = n⇩1› ‹n⇩4 ∈ S› show ?thesis
by(fastforce intro:combSlice_refl simp:HRB_slice_def)
next
assume "n'' ∈ set ns'"
with ‹matched n⇩2 ns' n⇩3› have "n'' ∈ sum_SDG_slice2 n⇩3"
by(rule in_matched_in_slice2)
with ‹n⇩3 -p:V'→⇘out⇙ n⇩4› have "n'' ∈ sum_SDG_slice2 n⇩4"
by(fastforce intro:slice2_param_out_slice2 SDG_edge_sum_SDG_edge)
from ‹n⇩3 -p:V'→⇘out⇙ n⇩4› have "valid_SDG_node n⇩4" by(rule SDG_edge_valid_SDG_node)
hence "n⇩4 ∈ sum_SDG_slice1 n⇩4" by(rule refl_slice1)
from ‹n⇩3 -p:V'→⇘out⇙ n⇩4›
have "CFG_node (parent_node n⇩3) -p→⇘ret⇙ CFG_node (parent_node n⇩4)"
by(fastforce elim:SDG_edge.cases intro:SDG_return_edge)
with ‹n'' ∈ sum_SDG_slice2 n⇩4› ‹n⇩4 ∈ sum_SDG_slice1 n⇩4› ‹n⇩4 ∈ S›
show ?case by(fastforce intro:combSlice_Return_parent_node SDG_edge_sum_SDG_edge
simp:HRB_slice_def)
next
assume "n'' = n⇩3"
from ‹n⇩3 -p:V'→⇘out⇙ n⇩4› have "n⇩3 s-p:V'→⇘out⇙ n⇩4" by(rule SDG_edge_sum_SDG_edge)
from ‹n⇩3 -p:V'→⇘out⇙ n⇩4› have "valid_SDG_node n⇩4" by(rule SDG_edge_valid_SDG_node)
hence "n⇩4 ∈ sum_SDG_slice1 n⇩4" by(rule refl_slice1)
from ‹valid_SDG_node n⇩4› have "n⇩4 ∈ sum_SDG_slice2 n⇩4" by(rule refl_slice2)
with ‹n⇩3 s-p:V'→⇘out⇙ n⇩4› have "n⇩3 ∈ sum_SDG_slice2 n⇩4" by(rule param_out_slice2)
from ‹n⇩3 -p:V'→⇘out⇙ n⇩4›
have "CFG_node (parent_node n⇩3) -p→⇘ret⇙ CFG_node (parent_node n⇩4)"
by(fastforce elim:SDG_edge.cases intro:SDG_return_edge)
with ‹n⇩3 ∈ sum_SDG_slice2 n⇩4› ‹n⇩4 ∈ sum_SDG_slice1 n⇩4› ‹n'' = n⇩3› ‹n⇩4 ∈ S›
show ?case by(fastforce intro:combSlice_Return_parent_node SDG_edge_sum_SDG_edge
simp:HRB_slice_def)
qed
qed
theorem in_realizable_in_HRB_slice:
"⟦realizable n ns n'; n'' ∈ set ns; n' ∈ S⟧ ⟹ n'' ∈ HRB_slice S"
proof(induct arbitrary:S rule:realizable.induct)
case (realizable_matched n ns n') thus ?case by(rule in_matched_in_HRB_slice)
next
case (realizable_call n⇩0 ns n⇩1 p n⇩2 V ns' n⇩3)
note IH = ‹⋀S. ⟦n'' ∈ set ns; n⇩1 ∈ S⟧ ⟹ n'' ∈ HRB_slice S›
from ‹n'' ∈ set (ns@n⇩1#ns')› have "(n'' ∈ set ns ∨ n'' = n⇩1) ∨ n'' ∈ set ns'"
by auto
thus ?case apply -
proof(erule disjE)+
assume "n'' ∈ set ns"
from IH[OF this] have "n'' ∈ HRB_slice {n⇩1}" by simp
hence "n'' ∈ HRB_slice {n⇩2}"
proof(induct rule:HRB_slice_cases)
case (phase1 n nx)
from ‹nx ∈ {n⇩1}› have "nx = n⇩1" by simp
with ‹n ∈ sum_SDG_slice1 nx› ‹n⇩1 -p→⇘call⇙ n⇩2 ∨ n⇩1 -p:V→⇘in⇙ n⇩2›
have "n ∈ sum_SDG_slice1 n⇩2"
by(fastforce intro:slice1_call_slice1 slice1_param_in_slice1
SDG_edge_sum_SDG_edge)
thus ?case
by(fastforce intro:combine_SDG_slices.combSlice_refl simp:HRB_slice_def)
next
case (phase2 nx n' n'' p' n)
from ‹nx ∈ {n⇩1}› have "nx = n⇩1" by simp
with ‹n' ∈ sum_SDG_slice1 nx› ‹n⇩1 -p→⇘call⇙ n⇩2 ∨ n⇩1 -p:V→⇘in⇙ n⇩2›
have "n' ∈ sum_SDG_slice1 n⇩2"
by(fastforce intro:slice1_call_slice1 slice1_param_in_slice1
SDG_edge_sum_SDG_edge)
with ‹n'' s-p'→⇘ret⇙ CFG_node (parent_node n')› ‹n ∈ sum_SDG_slice2 n'› show ?case
by(fastforce intro:combine_SDG_slices.combSlice_Return_parent_node
simp:HRB_slice_def)
qed
from ‹matched n⇩2 ns' n⇩3› obtain nsx where "n⇩2 is-nsx→⇩d* n⇩3"
by(erule matched_is_SDG_path)
with ‹n'' ∈ HRB_slice {n⇩2}› ‹n⇩3 ∈ S› show ?thesis
by(fastforce intro:HRB_slice_is_SDG_path_HRB_slice)
next
assume "n'' = n⇩1"
from ‹matched n⇩2 ns' n⇩3› obtain nsx where "n⇩2 is-nsx→⇩d* n⇩3"
by(erule matched_is_SDG_path)
hence "n⇩2 ∈ sum_SDG_slice1 n⇩2"
by(fastforce intro:refl_slice1 is_SDG_path_valid_SDG_node)
with ‹n⇩1 -p→⇘call⇙ n⇩2 ∨ n⇩1 -p:V→⇘in⇙ n⇩2›
have "n⇩1 ∈ sum_SDG_slice1 n⇩2"
by(fastforce intro:call_slice1 param_in_slice1 SDG_edge_sum_SDG_edge)
hence "n⇩1 ∈ HRB_slice {n⇩2}" by(fastforce intro:combSlice_refl simp:HRB_slice_def)
with ‹n⇩2 is-nsx→⇩d* n⇩3› ‹n'' = n⇩1› ‹n⇩3 ∈ S› show ?thesis
by(fastforce intro:HRB_slice_is_SDG_path_HRB_slice)
next
assume "n'' ∈ set ns'"
from ‹matched n⇩2 ns' n⇩3› this ‹n⇩3 ∈ S› show ?thesis
by(rule in_matched_in_HRB_slice)
qed
qed
lemma slice1_ics_SDG_path:
assumes "n ∈ sum_SDG_slice1 n'" and "n ≠ n'"
obtains ns where "CFG_node (_Entry_) ics-ns→⇩d* n'" and "n ∈ set ns"
proof(atomize_elim)
from ‹n ∈ sum_SDG_slice1 n'›
have "n = n' ∨ (∃ns. CFG_node (_Entry_) ics-ns→⇩d* n' ∧ n ∈ set ns)"
proof(induct rule:sum_SDG_slice1.induct)
case refl_slice1 thus ?case by simp
next
case (cdep_slice1 n'' n)
from ‹n'' s⟶⇘cd⇙ n› have "valid_SDG_node n''" by(rule sum_SDG_edge_valid_SDG_node)
hence "n'' ics-[]→⇩d* n''" by(rule icsSp_Nil)
from ‹valid_SDG_node n''› have "valid_node (parent_node n'')"
by(rule valid_SDG_CFG_node)
thus ?case
proof(cases "parent_node n'' = (_Exit_)")
case True
with ‹valid_SDG_node n''› have "n'' = CFG_node (_Exit_)"
by(rule valid_SDG_node_parent_Exit)
with ‹n'' s⟶⇘cd⇙ n› have False by(fastforce intro:Exit_no_sum_SDG_edge_source)
thus ?thesis by simp
next
case False
from ‹n'' s⟶⇘cd⇙ n› have "valid_SDG_node n''"
by(rule sum_SDG_edge_valid_SDG_node)
from this False obtain ns
where "CFG_node (_Entry_) cc-ns→⇩d* n''"
by(erule Entry_cc_SDG_path_to_inner_node)
with ‹n'' s⟶⇘cd⇙ n› have "CFG_node (_Entry_) cc-ns@[n'']→⇩d* n"
by(fastforce intro:ccSp_Append_cdep sum_SDG_edge_SDG_edge)
hence "CFG_node (_Entry_) ics-ns@[n'']→⇩d* n"
by(rule cc_SDG_path_ics_SDG_path)
from ‹n = n' ∨ (∃ns. CFG_node (_Entry_) ics-ns→⇩d* n' ∧ n ∈ set ns)›
show ?thesis
proof
assume "n = n'"
with ‹CFG_node (_Entry_) ics-ns@[n'']→⇩d* n› show ?thesis by fastforce
next
assume "∃ns. CFG_node (_Entry_) ics-ns→⇩d* n' ∧ n ∈ set ns"
then obtain nsx where "CFG_node (_Entry_) ics-nsx→⇩d* n'" and "n ∈ set nsx"
by blast
then obtain ns' ns'' where "nsx = ns'@ns''" and "n ics-ns''→⇩d* n'"
by -(erule ics_SDG_path_split)
with ‹CFG_node (_Entry_) ics-ns@[n'']→⇩d* n›
show ?thesis by(fastforce intro:ics_SDG_path_Append)
qed
qed
next
case (ddep_slice1 n'' V n)
from ‹n'' s-V→⇩d⇩d n› have "valid_SDG_node n''" by(rule sum_SDG_edge_valid_SDG_node)
hence "n'' ics-[]→⇩d* n''" by(rule icsSp_Nil)
from ‹valid_SDG_node n''› have "valid_node (parent_node n'')"
by(rule valid_SDG_CFG_node)
thus ?case
proof(cases "parent_node n'' = (_Exit_)")
case True
with ‹valid_SDG_node n''› have "n'' = CFG_node (_Exit_)"
by(rule valid_SDG_node_parent_Exit)
with ‹n'' s-V→⇩d⇩d n› have False by(fastforce intro:Exit_no_sum_SDG_edge_source)
thus ?thesis by simp
next
case False
from ‹n'' s-V→⇩d⇩d n› have "valid_SDG_node n''"
by(rule sum_SDG_edge_valid_SDG_node)
from this False obtain ns
where "CFG_node (_Entry_) cc-ns→⇩d* n''"
by(erule Entry_cc_SDG_path_to_inner_node)
hence "CFG_node (_Entry_) ics-ns→⇩d* n''"
by(rule cc_SDG_path_ics_SDG_path)
show ?thesis
proof(cases "n'' = n")
case True
from ‹n = n' ∨ (∃ns. CFG_node (_Entry_) ics-ns→⇩d* n' ∧ n ∈ set ns)›
show ?thesis
proof
assume "n = n'"
with ‹n'' = n› show ?thesis by simp
next
assume "∃ns. CFG_node (_Entry_) ics-ns→⇩d* n' ∧ n ∈ set ns"
with ‹n'' = n› show ?thesis by fastforce
qed
next
case False
with ‹n'' s-V→⇩d⇩d n› ‹CFG_node (_Entry_) ics-ns→⇩d* n''›
have "CFG_node (_Entry_) ics-ns@[n'']→⇩d* n"
by -(rule icsSp_Append_ddep)
from ‹n = n' ∨ (∃ns. CFG_node (_Entry_) ics-ns→⇩d* n' ∧ n ∈ set ns)›
show ?thesis
proof
assume "n = n'"
with ‹CFG_node (_Entry_) ics-ns@[n'']→⇩d* n› show ?thesis by fastforce
next
assume "∃ns. CFG_node (_Entry_) ics-ns→⇩d* n' ∧ n ∈ set ns"
then obtain nsx where "CFG_node (_Entry_) ics-nsx→⇩d* n'" and "n ∈ set nsx"
by blast
then obtain ns' ns'' where "nsx = ns'@ns''" and "n ics-ns''→⇩d* n'"
by -(erule ics_SDG_path_split)
with ‹CFG_node (_Entry_) ics-ns@[n'']→⇩d* n›
show ?thesis by(fastforce intro:ics_SDG_path_Append)
qed
qed
qed
next
case (call_slice1 n'' p n)
from ‹n'' s-p→⇘call⇙ n› have "valid_SDG_node n''"
by(rule sum_SDG_edge_valid_SDG_node)
hence "n'' ics-[]→⇩d* n''" by(rule icsSp_Nil)
from ‹valid_SDG_node n''› have "valid_node (parent_node n'')"
by(rule valid_SDG_CFG_node)
thus ?case
proof(cases "parent_node n'' = (_Exit_)")
case True
with ‹valid_SDG_node n''› have "n'' = CFG_node (_Exit_)"
by(rule valid_SDG_node_parent_Exit)
with ‹n'' s-p→⇘call⇙ n› have False by(fastforce intro:Exit_no_sum_SDG_edge_source)
thus ?thesis by simp
next
case False
from ‹n'' s-p→⇘call⇙ n› have "valid_SDG_node n''"
by(rule sum_SDG_edge_valid_SDG_node)
from this False obtain ns
where "CFG_node (_Entry_) cc-ns→⇩d* n''"
by(erule Entry_cc_SDG_path_to_inner_node)
with ‹n'' s-p→⇘call⇙ n› have "CFG_node (_Entry_) cc-ns@[n'']→⇩d* n"
by(fastforce intro:ccSp_Append_call sum_SDG_edge_SDG_edge)
hence "CFG_node (_Entry_) ics-ns@[n'']→⇩d* n"
by(rule cc_SDG_path_ics_SDG_path)
from ‹n = n' ∨ (∃ns. CFG_node (_Entry_) ics-ns→⇩d* n' ∧ n ∈ set ns)›
show ?thesis
proof
assume "n = n'"
with ‹CFG_node (_Entry_) ics-ns@[n'']→⇩d* n› show ?thesis by fastforce
next
assume "∃ns. CFG_node (_Entry_) ics-ns→⇩d* n' ∧ n ∈ set ns"
then obtain nsx where "CFG_node (_Entry_) ics-nsx→⇩d* n'" and "n ∈ set nsx"
by blast
then obtain ns' ns'' where "nsx = ns'@ns''" and "n ics-ns''→⇩d* n'"
by -(erule ics_SDG_path_split)
with ‹CFG_node (_Entry_) ics-ns@[n'']→⇩d* n›
show ?thesis by(fastforce intro:ics_SDG_path_Append)
qed
qed
next
case (param_in_slice1 n'' p V n)
from ‹n'' s-p:V→⇘in⇙ n› have "valid_SDG_node n''"
by(rule sum_SDG_edge_valid_SDG_node)
hence "n'' ics-[]→⇩d* n''" by(rule icsSp_Nil)
from ‹valid_SDG_node n''› have "valid_node (parent_node n'')"
by(rule valid_SDG_CFG_node)
thus ?case
proof(cases "parent_node n'' = (_Exit_)")
case True
with ‹valid_SDG_node n''› have "n'' = CFG_node (_Exit_)"
by(rule valid_SDG_node_parent_Exit)
with ‹n'' s-p:V→⇘in⇙ n› have False by(fastforce intro:Exit_no_sum_SDG_edge_source)
thus ?thesis by simp
next
case False
from ‹n'' s-p:V→⇘in⇙ n› have "valid_SDG_node n''"
by(rule sum_SDG_edge_valid_SDG_node)
from this False obtain ns
where "CFG_node (_Entry_) cc-ns→⇩d* n''"
by(erule Entry_cc_SDG_path_to_inner_node)
hence "CFG_node (_Entry_) ics-ns→⇩d* n''"
by(rule cc_SDG_path_ics_SDG_path)
with ‹n'' s-p:V→⇘in⇙ n› have "CFG_node (_Entry_) ics-ns@[n'']→⇩d* n"
by -(rule icsSp_Append_param_in)
from ‹n = n' ∨ (∃ns. CFG_node (_Entry_) ics-ns→⇩d* n' ∧ n ∈ set ns)›
show ?thesis
proof
assume "n = n'"
with ‹CFG_node (_Entry_) ics-ns@[n'']→⇩d* n› show ?thesis by fastforce
next
assume "∃ns. CFG_node (_Entry_) ics-ns→⇩d* n' ∧ n ∈ set ns"
then obtain nsx where "CFG_node (_Entry_) ics-nsx→⇩d* n'" and "n ∈ set nsx"
by blast
then obtain ns' ns'' where "nsx = ns'@ns''" and "n ics-ns''→⇩d* n'"
by -(erule ics_SDG_path_split)
with ‹CFG_node (_Entry_) ics-ns@[n'']→⇩d* n›
show ?thesis by(fastforce intro:ics_SDG_path_Append)
qed
qed
next
case (sum_slice1 n'' p n)
from ‹n'' s-p→⇘sum⇙ n› have "valid_SDG_node n''"
by(rule sum_SDG_edge_valid_SDG_node)
hence "n'' ics-[]→⇩d* n''" by(rule icsSp_Nil)
from ‹valid_SDG_node n''› have "valid_node (parent_node n'')"
by(rule valid_SDG_CFG_node)
thus ?case
proof(cases "parent_node n'' = (_Exit_)")
case True
with ‹valid_SDG_node n''› have "n'' = CFG_node (_Exit_)"
by(rule valid_SDG_node_parent_Exit)
with ‹n'' s-p→⇘sum⇙ n› have False by(fastforce intro:Exit_no_sum_SDG_edge_source)
thus ?thesis by simp
next
case False
from ‹n'' s-p→⇘sum⇙ n› have "valid_SDG_node n''"
by(rule sum_SDG_edge_valid_SDG_node)
from this False obtain ns
where "CFG_node (_Entry_) cc-ns→⇩d* n''"
by(erule Entry_cc_SDG_path_to_inner_node)
hence "CFG_node (_Entry_) ics-ns→⇩d* n''"
by(rule cc_SDG_path_ics_SDG_path)
with ‹n'' s-p→⇘sum⇙ n› have "CFG_node (_Entry_) ics-ns@[n'']→⇩d* n"
by -(rule icsSp_Append_sum)
from ‹n = n' ∨ (∃ns. CFG_node (_Entry_) ics-ns→⇩d* n' ∧ n ∈ set ns)›
show ?thesis
proof
assume "n = n'"
with ‹CFG_node (_Entry_) ics-ns@[n'']→⇩d* n› show ?thesis by fastforce
next
assume "∃ns. CFG_node (_Entry_) ics-ns→⇩d* n' ∧ n ∈ set ns"
then obtain nsx where "CFG_node (_Entry_) ics-nsx→⇩d* n'" and "n ∈ set nsx"
by blast
then obtain ns' ns'' where "nsx = ns'@ns''" and "n ics-ns''→⇩d* n'"
by -(erule ics_SDG_path_split)
with ‹CFG_node (_Entry_) ics-ns@[n'']→⇩d* n›
show ?thesis by(fastforce intro:ics_SDG_path_Append)
qed
qed
qed
with ‹n ≠ n'› show "∃ns. CFG_node (_Entry_) ics-ns→⇩d* n' ∧ n ∈ set ns" by simp
qed
lemma slice2_irs_SDG_path:
assumes "n ∈ sum_SDG_slice2 n'" and "valid_SDG_node n'"
obtains ns where "n irs-ns→⇩d* n'"
using assms
by(induct rule:sum_SDG_slice2.induct,auto intro:intra_return_sum_SDG_path.intros)
theorem HRB_slice_realizable:
assumes "n ∈ HRB_slice S" and "∀n' ∈ S. valid_SDG_node n'" and "n ∉ S"
obtains n' ns where "n' ∈ S" and "realizable (CFG_node (_Entry_)) ns n'"
and "n ∈ set ns"
proof(atomize_elim)
from ‹n ∈ HRB_slice S› ‹n ∉ S›
show "∃n' ns. n' ∈ S ∧ realizable (CFG_node (_Entry_)) ns n' ∧ n ∈ set ns"
proof(induct rule:HRB_slice_cases)
case (phase1 n nx)
with ‹n ∉ S› show ?case
by(fastforce elim:slice1_ics_SDG_path ics_SDG_path_realizable)
next
case (phase2 n' nx n'' p n)
from ‹∀n' ∈ S. valid_SDG_node n'› ‹n' ∈ S› have "valid_SDG_node n'" by simp
with ‹nx ∈ sum_SDG_slice1 n'› have "valid_SDG_node nx"
by(auto elim:slice1_ics_SDG_path ics_SDG_path_split
intro:ics_SDG_path_valid_SDG_node)
with ‹n ∈ sum_SDG_slice2 nx›
obtain nsx where "n irs-nsx→⇩d* nx" by(erule slice2_irs_SDG_path)
show ?case
proof(cases "n = nx")
case True
show ?thesis
proof(cases "nx = n'")
case True
with ‹n = nx› ‹n ∉ S› ‹n' ∈ S› have False by simp
thus ?thesis by simp
next
case False
with ‹nx ∈ sum_SDG_slice1 n'› obtain ns
where "realizable (CFG_node (_Entry_)) ns n'" and "nx ∈ set ns"
by(fastforce elim:slice1_ics_SDG_path ics_SDG_path_realizable)
with ‹n = nx› ‹n' ∈ S› show ?thesis by blast
qed
next
case False
with ‹n irs-nsx→⇩d* nx› obtain ns
where "realizable (CFG_node (_Entry_)) ns nx" and "n ∈ set ns"
by(erule irs_SDG_path_realizable)
show ?thesis
proof(cases "nx = n'")
case True
with ‹realizable (CFG_node (_Entry_)) ns nx› ‹n ∈ set ns› ‹n' ∈ S›
show ?thesis by blast
next
case False
with ‹nx ∈ sum_SDG_slice1 n'› obtain nsx'
where "CFG_node (_Entry_) ics-nsx'→⇩d* n'" and "nx ∈ set nsx'"
by(erule slice1_ics_SDG_path)
then obtain ns' where "nx ics-ns'→⇩d* n'" by -(erule ics_SDG_path_split)
with ‹realizable (CFG_node (_Entry_)) ns nx›
obtain ns'' where "realizable (CFG_node (_Entry_)) (ns@ns'') n'"
by(erule realizable_Append_ics_SDG_path)
with ‹n ∈ set ns› ‹n' ∈ S› show ?thesis by fastforce
qed
qed
qed
qed
theorem HRB_slice_precise:
"⟦∀n' ∈ S. valid_SDG_node n'; n ∉ S⟧ ⟹
n ∈ HRB_slice S =
(∃n' ns. n' ∈ S ∧ realizable (CFG_node (_Entry_)) ns n' ∧ n ∈ set ns)"
by(fastforce elim:HRB_slice_realizable intro:in_realizable_in_HRB_slice)
end
end
Theory SCDObservable
section ‹Observable sets w.r.t.\ standard control dependence›
theory SCDObservable imports Observable HRBSlice begin
context SDG begin
lemma matched_bracket_assms_variant:
assumes "n⇩1 -p→⇘call⇙ n⇩2 ∨ n⇩1 -p:V'→⇘in⇙ n⇩2" and "matched n⇩2 ns' n⇩3"
and "n⇩3 -p→⇘ret⇙ n⇩4 ∨ n⇩3 -p:V→⇘out⇙ n⇩4"
and "call_of_return_node (parent_node n⇩4) (parent_node n⇩1)"
obtains a a' where "valid_edge a" and "a' ∈ get_return_edges a"
and "sourcenode a = parent_node n⇩1" and "targetnode a = parent_node n⇩2"
and "sourcenode a' = parent_node n⇩3" and "targetnode a' = parent_node n⇩4"
proof(atomize_elim)
from ‹n⇩1 -p→⇘call⇙ n⇩2 ∨ n⇩1 -p:V'→⇘in⇙ n⇩2› obtain a Q r fs where "valid_edge a"
and "kind a = Q:r↪⇘p⇙fs" and "parent_node n⇩1 = sourcenode a"
and "parent_node n⇩2 = targetnode a"
by(fastforce elim:SDG_edge.cases)
from ‹n⇩3 -p→⇘ret⇙ n⇩4 ∨ n⇩3 -p:V→⇘out⇙ n⇩4› obtain a' Q' f'
where "valid_edge a'" and "kind a' = Q'↩⇘p⇙f'"
and "parent_node n⇩3 = sourcenode a'" and "parent_node n⇩4 = targetnode a'"
by(fastforce elim:SDG_edge.cases)
from ‹valid_edge a'› ‹kind a' = Q'↩⇘p⇙f'›
obtain ax where "valid_edge ax" and "∃Q r fs. kind ax = Q:r↪⇘p⇙fs"
and "a' ∈ get_return_edges ax"
by -(drule return_needs_call,fastforce+)
from ‹valid_edge a› ‹valid_edge ax› ‹kind a = Q:r↪⇘p⇙fs› ‹∃Q r fs. kind ax = Q:r↪⇘p⇙fs›
have "targetnode a = targetnode ax" by(fastforce dest:same_proc_call_unique_target)
from ‹valid_edge a'› ‹a' ∈ get_return_edges ax› ‹valid_edge ax›
have "call_of_return_node (targetnode a') (sourcenode ax)"
by(fastforce simp:return_node_def call_of_return_node_def)
with ‹call_of_return_node (parent_node n⇩4) (parent_node n⇩1)›
‹parent_node n⇩4 = targetnode a'›
have "sourcenode ax = parent_node n⇩1" by fastforce
with ‹valid_edge ax› ‹a' ∈ get_return_edges ax› ‹targetnode a = targetnode ax›
‹parent_node n⇩2 = targetnode a› ‹parent_node n⇩3 = sourcenode a'›
‹parent_node n⇩4 = targetnode a'›
show "∃a a'. valid_edge a ∧ a' ∈ get_return_edges a ∧
sourcenode a = parent_node n⇩1 ∧ targetnode a = parent_node n⇩2 ∧
sourcenode a' = parent_node n⇩3 ∧ targetnode a' = parent_node n⇩4"
by fastforce
qed
subsection ‹Observable set of standard control dependence is at most a singleton›
definition SDG_to_CFG_set :: "'node SDG_node set ⇒ 'node set" ("⌊_⌋⇘CFG⇙")
where "⌊S⌋⇘CFG⇙ ≡ {m. CFG_node m ∈ S}"
lemma [intro]:"∀n ∈ S. valid_SDG_node n ⟹ ∀n ∈ ⌊S⌋⇘CFG⇙. valid_node n"
by(fastforce simp:SDG_to_CFG_set_def)
lemma Exit_HRB_Slice:
assumes "n ∈ ⌊HRB_slice {CFG_node (_Exit_)}⌋⇘CFG⇙" shows "n = (_Exit_)"
proof -
from ‹n ∈ ⌊HRB_slice {CFG_node (_Exit_)}⌋⇘CFG⇙›
have "CFG_node n ∈ HRB_slice {CFG_node (_Exit_)}"
by(simp add:SDG_to_CFG_set_def)
thus ?thesis
proof(induct "CFG_node n" rule:HRB_slice_cases)
case (phase1 nx)
from ‹nx ∈ {CFG_node (_Exit_)}› have "nx = CFG_node (_Exit_)" by simp
with ‹CFG_node n ∈ sum_SDG_slice1 nx›
have "CFG_node n = CFG_node (_Exit_) ∨
(∃n Vopt popt b. sum_SDG_edge n Vopt popt b (CFG_node (_Exit_)))"
by(induct rule:sum_SDG_slice1.induct) auto
then show ?thesis by(fastforce dest:Exit_no_sum_SDG_edge_target)
next
case (phase2 nx n' n'' p)
from ‹nx ∈ {CFG_node (_Exit_)}› have "nx = CFG_node (_Exit_)" by simp
with ‹n' ∈ sum_SDG_slice1 nx›
have "n' = CFG_node (_Exit_) ∨
(∃n Vopt popt b. sum_SDG_edge n Vopt popt b (CFG_node (_Exit_)))"
by(induct rule:sum_SDG_slice1.induct) auto
hence "n' = CFG_node (_Exit_)" by(fastforce dest:Exit_no_sum_SDG_edge_target)
with ‹CFG_node n ∈ sum_SDG_slice2 n'›
have "CFG_node n = CFG_node (_Exit_) ∨
(∃n Vopt popt b. sum_SDG_edge n Vopt popt b (CFG_node (_Exit_)))"
by(induct rule:sum_SDG_slice2.induct) auto
then show ?thesis by(fastforce dest:Exit_no_sum_SDG_edge_target)
qed
qed
lemma Exit_in_obs_intra_slice_node:
assumes "(_Exit_) ∈ obs_intra n' ⌊HRB_slice S⌋⇘CFG⇙"
shows "CFG_node (_Exit_) ∈ S"
proof -
let ?S' = "⌊HRB_slice S⌋⇘CFG⇙"
from ‹(_Exit_) ∈ obs_intra n' ?S'› obtain as where "n' -as→⇩ι* (_Exit_)"
and "∀nx ∈ set(sourcenodes as). nx ∉ ?S'" and "(_Exit_) ∈ ?S'"
by(erule obs_intraE)
from ‹(_Exit_) ∈ ?S'›
have "CFG_node (_Exit_) ∈ HRB_slice S" by(simp add:SDG_to_CFG_set_def)
thus ?thesis
proof(induct "CFG_node (_Exit_)" rule:HRB_slice_cases)
case (phase1 nx)
thus ?case
by(induct "CFG_node (_Exit_)" rule:sum_SDG_slice1.induct,
auto dest:Exit_no_sum_SDG_edge_source)
next
case (phase2 nx n' n'' p)
from ‹CFG_node (_Exit_) ∈ sum_SDG_slice2 n'› ‹n' ∈ sum_SDG_slice1 nx› ‹nx ∈ S›
show ?case
apply(induct n≡"CFG_node (_Exit_)" rule:sum_SDG_slice2.induct)
apply(auto dest:Exit_no_sum_SDG_edge_source)
apply(hypsubst_thin)
apply(induct n≡"CFG_node (_Exit_)" rule:sum_SDG_slice1.induct)
apply(auto dest:Exit_no_sum_SDG_edge_source)
done
qed
qed
lemma obs_intra_postdominate:
assumes "n ∈ obs_intra n' ⌊HRB_slice S⌋⇘CFG⇙" and "¬ method_exit n"
shows "n postdominates n'"
proof(rule ccontr)
assume "¬ n postdominates n'"
from ‹n ∈ obs_intra n' ⌊HRB_slice S⌋⇘CFG⇙› have "valid_node n"
by(fastforce dest:in_obs_intra_valid)
with ‹n ∈ obs_intra n' ⌊HRB_slice S⌋⇘CFG⇙› ‹¬ method_exit n› have "n postdominates n"
by(fastforce intro:postdominate_refl)
from ‹n ∈ obs_intra n' ⌊HRB_slice S⌋⇘CFG⇙› obtain as where "n' -as→⇩ι* n"
and all_notinS:"∀n' ∈ set(sourcenodes as). n' ∉ ⌊HRB_slice S⌋⇘CFG⇙"
and "n ∈ ⌊HRB_slice S⌋⇘CFG⇙" by(erule obs_intraE)
from ‹n postdominates n› ‹¬ n postdominates n'› ‹n' -as→⇩ι* n›
obtain as' a as'' where [simp]:"as = as'@a#as''"
and "valid_edge a" and "¬ n postdominates (sourcenode a)"
and "n postdominates (targetnode a)" and "intra_kind (kind a)"
by(fastforce elim!:postdominate_path_branch simp:intra_path_def)
from ‹n' -as→⇩ι* n› have "sourcenode a -a#as''→⇩ι* n"
by(fastforce elim:path_split intro:Cons_path simp:intra_path_def)
with ‹¬ n postdominates (sourcenode a)› ‹valid_edge a› ‹valid_node n›
obtain asx pex where "sourcenode a -asx→⇩ι* pex" and "method_exit pex"
and "n ∉ set(sourcenodes asx)" by(fastforce simp:postdominate_def)
have "asx ≠ []"
proof
assume "asx = []"
with ‹sourcenode a -asx→⇩ι* pex› have "sourcenode a = pex"
by(fastforce simp:intra_path_def)
from ‹method_exit pex› show False
proof(rule method_exit_cases)
assume "pex = (_Exit_)"
with ‹sourcenode a = pex› have "sourcenode a = (_Exit_)" by simp
with ‹valid_edge a› show False by(rule Exit_source)
next
fix a' Q f p
assume "pex = sourcenode a'" and "valid_edge a'" and "kind a' = Q↩⇘p⇙f"
from ‹valid_edge a'› ‹kind a' = Q↩⇘p⇙f› ‹valid_edge a› ‹intra_kind (kind a)›
‹sourcenode a = pex› ‹pex = sourcenode a'›
show False by(fastforce dest:return_edges_only simp:intra_kind_def)
qed
qed
then obtain ax asx' where [simp]:"asx = ax#asx'" by(cases asx) auto
with ‹sourcenode a -asx→⇩ι* pex› have "sourcenode a -ax#asx'→* pex"
by(simp add:intra_path_def)
hence "valid_edge ax" and [simp]:"sourcenode a = sourcenode ax"
and "targetnode ax -asx'→* pex" by(auto elim:path_split_Cons)
with ‹sourcenode a -asx→⇩ι* pex› have "targetnode ax -asx'→⇩ι* pex"
by(simp add:intra_path_def)
with ‹valid_edge ax› ‹n ∉ set(sourcenodes asx)› ‹method_exit pex›
have "¬ n postdominates targetnode ax"
by(fastforce simp:postdominate_def sourcenodes_def)
from ‹n ∈ obs_intra n' ⌊HRB_slice S⌋⇘CFG⇙› all_notinS
have "n ∉ set (sourcenodes (a#as''))"
by(fastforce elim:obs_intra.cases simp:sourcenodes_def)
from ‹sourcenode a -asx→⇩ι* pex› have "intra_kind (kind ax)"
by(simp add:intra_path_def)
with ‹sourcenode a -a#as''→⇩ι* n› ‹n postdominates (targetnode a)›
‹¬ n postdominates targetnode ax› ‹valid_edge ax›
‹n ∉ set (sourcenodes (a#as''))› ‹intra_kind (kind a)›
have "(sourcenode a) controls n"
by(fastforce simp:control_dependence_def)
hence "CFG_node (sourcenode a) s⟶⇘cd⇙ CFG_node n"
by(fastforce intro:sum_SDG_cdep_edge)
with ‹n ∈ obs_intra n' ⌊HRB_slice S⌋⇘CFG⇙› have "sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙"
by(auto elim!:obs_intraE combine_SDG_slices.cases
intro:combine_SDG_slices.intros sum_SDG_slice1.intros
sum_SDG_slice2.intros simp:HRB_slice_def SDG_to_CFG_set_def)
with all_notinS show False by(simp add:sourcenodes_def)
qed
lemma obs_intra_singleton_disj:
assumes "valid_node n"
shows "(∃m. obs_intra n ⌊HRB_slice S⌋⇘CFG⇙ = {m}) ∨
obs_intra n ⌊HRB_slice S⌋⇘CFG⇙ = {}"
proof(rule ccontr)
assume "¬ ((∃m. obs_intra n ⌊HRB_slice S⌋⇘CFG⇙ = {m}) ∨
obs_intra n ⌊HRB_slice S⌋⇘CFG⇙ = {})"
hence "∃nx nx'. nx ∈ obs_intra n ⌊HRB_slice S⌋⇘CFG⇙ ∧
nx' ∈ obs_intra n ⌊HRB_slice S⌋⇘CFG⇙ ∧ nx ≠ nx'" by auto
then obtain nx nx' where "nx ∈ obs_intra n ⌊HRB_slice S⌋⇘CFG⇙"
and "nx' ∈ obs_intra n ⌊HRB_slice S⌋⇘CFG⇙" and "nx ≠ nx'" by auto
from ‹nx ∈ obs_intra n ⌊HRB_slice S⌋⇘CFG⇙› obtain as where "n -as→⇩ι* nx"
and all:"∀n' ∈ set(sourcenodes as). n' ∉ ⌊HRB_slice S⌋⇘CFG⇙"
and "nx ∈ ⌊HRB_slice S⌋⇘CFG⇙"
by(erule obs_intraE)
from ‹n -as→⇩ι* nx› have "n -as→* nx" and "∀a ∈ set as. intra_kind (kind a)"
by(simp_all add:intra_path_def)
hence "valid_node nx" by(fastforce dest:path_valid_node)
with ‹nx ∈ ⌊HRB_slice S⌋⇘CFG⇙› have "obs_intra nx ⌊HRB_slice S⌋⇘CFG⇙ = {nx}"
by -(rule n_in_obs_intra)
with ‹n -as→* nx› ‹nx ∈ obs_intra n ⌊HRB_slice S⌋⇘CFG⇙›
‹nx' ∈ obs_intra n ⌊HRB_slice S⌋⇘CFG⇙› ‹nx ≠ nx'› have "as ≠ []"
by(fastforce elim:path.cases simp:intra_path_def)
with ‹n -as→* nx› ‹nx ∈ obs_intra n ⌊HRB_slice S⌋⇘CFG⇙›
‹nx' ∈ obs_intra n ⌊HRB_slice S⌋⇘CFG⇙› ‹nx ≠ nx'›
‹obs_intra nx ⌊HRB_slice S⌋⇘CFG⇙ = {nx}› ‹∀a ∈ set as. intra_kind (kind a)› all
have "∃a as' as''. n -as'→⇩ι* sourcenode a ∧ targetnode a -as''→⇩ι* nx ∧
valid_edge a ∧ as = as'@a#as'' ∧ intra_kind (kind a) ∧
obs_intra (targetnode a) ⌊HRB_slice S⌋⇘CFG⇙ = {nx} ∧
(¬ (∃m. obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙ = {m} ∨
obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙ = {}))"
proof(induct arbitrary:nx' rule:path.induct)
case (Cons_path n'' as n' a n)
note IH = ‹⋀nx'. ⟦n' ∈ obs_intra n'' ⌊HRB_slice S⌋⇘CFG⇙;
nx' ∈ obs_intra n'' ⌊HRB_slice S⌋⇘CFG⇙; n' ≠ nx';
obs_intra n' ⌊HRB_slice S⌋⇘CFG⇙ = {n'};
∀a∈set as. intra_kind (kind a);
∀n'∈set (sourcenodes as). n' ∉ ⌊HRB_slice S⌋⇘CFG⇙; as ≠ []⟧
⟹ ∃a as' as''. n'' -as'→⇩ι* sourcenode a ∧ targetnode a -as''→⇩ι* n' ∧
valid_edge a ∧ as = as'@a#as'' ∧ intra_kind (kind a) ∧
obs_intra (targetnode a) ⌊HRB_slice S⌋⇘CFG⇙ = {n'} ∧
(¬ (∃m. obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙ = {m} ∨
obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙ = {}))›
note more_than_one = ‹n' ∈ obs_intra n ⌊HRB_slice S⌋⇘CFG⇙›
‹nx' ∈ obs_intra n ⌊HRB_slice S⌋⇘CFG⇙› ‹n' ≠ nx'›
from ‹∀a∈set (a#as). intra_kind (kind a)›
have "∀a∈set as. intra_kind (kind a)" and "intra_kind (kind a)" by simp_all
from ‹∀n'∈set (sourcenodes (a#as)). n' ∉ ⌊HRB_slice S⌋⇘CFG⇙›
have all:"∀n'∈set (sourcenodes as). n' ∉ ⌊HRB_slice S⌋⇘CFG⇙"
by(simp add:sourcenodes_def)
show ?case
proof(cases "as = []")
case True
with ‹n'' -as→* n'› have [simp]:"n'' = n'" by(fastforce elim:path.cases)
from more_than_one ‹sourcenode a = n›
have "¬ (∃m. obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙ = {m} ∨
obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙ = {})"
by auto
with ‹targetnode a = n''› ‹obs_intra n' ⌊HRB_slice S⌋⇘CFG⇙ = {n'}›
‹sourcenode a = n› True ‹valid_edge a› ‹intra_kind (kind a)›
show ?thesis
apply(rule_tac x="a" in exI)
apply(rule_tac x="[]" in exI)
apply(rule_tac x="[]" in exI)
by(auto intro:empty_path simp:intra_path_def)
next
case False
from ‹n'' -as→* n'› ‹∀a∈set (a # as). intra_kind (kind a)›
have "n'' -as→⇩ι* n'" by(simp add:intra_path_def)
with all
have subset:"obs_intra n' ⌊HRB_slice S⌋⇘CFG⇙ ⊆ obs_intra n'' ⌊HRB_slice S⌋⇘CFG⇙"
by -(rule path_obs_intra_subset)
thus ?thesis
proof(cases "obs_intra n' ⌊HRB_slice S⌋⇘CFG⇙ = obs_intra n'' ⌊HRB_slice S⌋⇘CFG⇙")
case True
with ‹n'' -as→⇩ι* n'› ‹valid_edge a› ‹sourcenode a = n› ‹targetnode a = n''›
‹obs_intra n' ⌊HRB_slice S⌋⇘CFG⇙ = {n'}› ‹intra_kind (kind a)› more_than_one
show ?thesis
apply(rule_tac x="a" in exI)
apply(rule_tac x="[]" in exI)
apply(rule_tac x="as" in exI)
by(fastforce intro:empty_path simp:intra_path_def)
next
case False
with subset
have "obs_intra n' ⌊HRB_slice S⌋⇘CFG⇙ ⊂ obs_intra n'' ⌊HRB_slice S⌋⇘CFG⇙" by simp
with ‹obs_intra n' ⌊HRB_slice S⌋⇘CFG⇙ = {n'}›
obtain ni where "n' ∈ obs_intra n'' ⌊HRB_slice S⌋⇘CFG⇙"
and "ni ∈ obs_intra n'' ⌊HRB_slice S⌋⇘CFG⇙" and "n' ≠ ni" by auto
from IH[OF this ‹obs_intra n' ⌊HRB_slice S⌋⇘CFG⇙ = {n'}›
‹∀a∈set as. intra_kind (kind a)› all ‹as ≠ []›] obtain a' as' as''
where "n'' -as'→⇩ι* sourcenode a'"
and hyps:"targetnode a' -as''→⇩ι* n'" "valid_edge a'" "as = as'@a'#as''"
"intra_kind (kind a')" "obs_intra (targetnode a') ⌊HRB_slice S⌋⇘CFG⇙ = {n'}"
"¬ (∃m. obs_intra (sourcenode a') ⌊HRB_slice S⌋⇘CFG⇙ = {m} ∨
obs_intra (sourcenode a') ⌊HRB_slice S⌋⇘CFG⇙ = {})"
by blast
from ‹n'' -as'→⇩ι* sourcenode a'› ‹valid_edge a› ‹sourcenode a = n›
‹targetnode a = n''› ‹intra_kind (kind a)› ‹intra_kind (kind a')›
have "n -a#as'→⇩ι* sourcenode a'"
by(fastforce intro:path.Cons_path simp:intra_path_def)
with hyps show ?thesis
apply(rule_tac x="a'" in exI)
apply(rule_tac x="a#as'" in exI)
apply(rule_tac x="as''" in exI)
by fastforce
qed
qed
qed simp
then obtain a as' as'' where "valid_edge a" and "intra_kind (kind a)"
and "obs_intra (targetnode a) ⌊HRB_slice S⌋⇘CFG⇙ = {nx}"
and more_than_one:"¬ (∃m. obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙ = {m} ∨
obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙ = {})"
by blast
have "sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙"
proof(rule ccontr)
assume "¬ sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙"
hence "sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙" by simp
with ‹valid_edge a›
have "obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙ = {sourcenode a}"
by(fastforce intro!:n_in_obs_intra)
with more_than_one show False by simp
qed
with ‹valid_edge a› ‹intra_kind (kind a)›
have "obs_intra (targetnode a) ⌊HRB_slice S⌋⇘CFG⇙ ⊆
obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙"
by(rule edge_obs_intra_subset)
with ‹obs_intra (targetnode a) ⌊HRB_slice S⌋⇘CFG⇙ = {nx}›
have "nx ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙" by simp
with more_than_one obtain m
where "m ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙" and "nx ≠ m" by auto
from ‹m ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙› have "valid_node m"
by(fastforce dest:in_obs_intra_valid)
from ‹obs_intra (targetnode a) ⌊HRB_slice S⌋⇘CFG⇙ = {nx}› have "valid_node nx"
by(fastforce dest:in_obs_intra_valid)
show False
proof(cases "m postdominates (sourcenode a)")
case True
with ‹nx ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙›
‹m ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙›
have "m postdominates nx"
by(fastforce intro:postdominate_inner_path_targetnode elim:obs_intraE)
with ‹nx ≠ m› have "¬ nx postdominates m" by(fastforce dest:postdominate_antisym)
with ‹valid_node nx› ‹valid_node m› obtain asx pex where "m -asx→⇩ι* pex"
and "method_exit pex" and "nx ∉ set(sourcenodes asx)"
by(fastforce simp:postdominate_def)
have "¬ nx postdominates (sourcenode a)"
proof
assume "nx postdominates sourcenode a"
from ‹nx ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙›
‹m ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙›
obtain asx' where "sourcenode a -asx'→⇩ι* m" and "nx ∉ set(sourcenodes asx')"
by(fastforce elim:obs_intraE)
with ‹m -asx→⇩ι* pex› have "sourcenode a -asx'@asx→⇩ι* pex"
by(fastforce intro:path_Append simp:intra_path_def)
with ‹nx ∉ set(sourcenodes asx)› ‹nx ∉ set(sourcenodes asx')›
‹nx postdominates sourcenode a› ‹method_exit pex› show False
by(fastforce simp:sourcenodes_def postdominate_def)
qed
show False
proof(cases "method_exit nx")
case True
from ‹m postdominates nx› obtain xs where "nx -xs→⇩ι* m"
by -(erule postdominate_implies_inner_path)
with True have "nx = m"
by(fastforce dest!:method_exit_inner_path simp:intra_path_def)
with ‹nx ≠ m› show False by simp
next
case False
with ‹nx ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙›
have "nx postdominates sourcenode a" by(rule obs_intra_postdominate)
with ‹¬ nx postdominates (sourcenode a)› show False by simp
qed
next
case False
show False
proof(cases "method_exit m")
case True
from ‹m ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙›
‹nx ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙›
obtain xs where "sourcenode a -xs→⇩ι* m" and "nx ∉ set(sourcenodes xs)"
by(fastforce elim:obs_intraE)
obtain x' xs' where [simp]:"xs = x'#xs'"
proof(cases xs)
case Nil
with ‹sourcenode a -xs→⇩ι* m› have [simp]:"sourcenode a = m"
by(fastforce simp:intra_path_def)
with ‹m ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙›
have "m ∈ ⌊HRB_slice S⌋⇘CFG⇙" by(metis obs_intraE)
with ‹valid_node m› have "obs_intra m ⌊HRB_slice S⌋⇘CFG⇙ = {m}"
by(rule n_in_obs_intra)
with ‹nx ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙› ‹nx ≠ m› have False
by fastforce
thus ?thesis by simp
qed blast
from ‹sourcenode a -xs→⇩ι* m› have "sourcenode a = sourcenode x'"
and "valid_edge x'" and "targetnode x' -xs'→⇩ι* m"
and "intra_kind (kind x')"
by(auto elim:path_split_Cons simp:intra_path_def)
from ‹targetnode x' -xs'→⇩ι* m› ‹nx ∉ set(sourcenodes xs)› ‹valid_edge x'›
‹valid_node m› True
have "¬ nx postdominates (targetnode x')"
by(fastforce simp:postdominate_def sourcenodes_def)
show False
proof(cases "method_exit nx")
case True
from ‹m ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙›
‹nx ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙›
have "get_proc m = get_proc nx"
by(fastforce elim:obs_intraE dest:intra_path_get_procs)
with ‹method_exit m› ‹method_exit nx› have "m = nx"
by(rule method_exit_unique)
with ‹nx ≠ m› show False by simp
next
case False
with ‹obs_intra (targetnode a) ⌊HRB_slice S⌋⇘CFG⇙ = {nx}›
have "nx postdominates (targetnode a)"
by(fastforce intro:obs_intra_postdominate)
from ‹obs_intra (targetnode a) ⌊HRB_slice S⌋⇘CFG⇙ = {nx}›
obtain ys where "targetnode a -ys→⇩ι* nx"
and "∀nx' ∈ set(sourcenodes ys). nx' ∉ ⌊HRB_slice S⌋⇘CFG⇙"
and "nx ∈ ⌊HRB_slice S⌋⇘CFG⇙" by(fastforce elim:obs_intraE)
hence "nx ∉ set(sourcenodes ys)"by fastforce
have "sourcenode a ≠ nx"
proof
assume "sourcenode a = nx"
from ‹nx ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙›
have "nx ∈ ⌊HRB_slice S⌋⇘CFG⇙" by -(erule obs_intraE)
with ‹valid_node nx›
have "obs_intra nx ⌊HRB_slice S⌋⇘CFG⇙ = {nx}" by -(erule n_in_obs_intra)
with ‹sourcenode a = nx› ‹m ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙›
‹nx ≠ m› show False by fastforce
qed
with ‹nx ∉ set(sourcenodes ys)› have "nx ∉ set(sourcenodes (a#ys))"
by(fastforce simp:sourcenodes_def)
from ‹valid_edge a› ‹targetnode a -ys→⇩ι* nx› ‹intra_kind (kind a)›
have "sourcenode a -a#ys→⇩ι* nx"
by(fastforce intro:Cons_path simp:intra_path_def)
from ‹sourcenode a -a#ys→⇩ι* nx› ‹nx ∉ set(sourcenodes (a#ys))›
‹intra_kind (kind a)› ‹nx postdominates (targetnode a)›
‹valid_edge x'› ‹intra_kind (kind x')› ‹¬ nx postdominates (targetnode x')›
‹sourcenode a = sourcenode x'›
have "(sourcenode a) controls nx"
by(fastforce simp:control_dependence_def)
hence "CFG_node (sourcenode a) ⟶⇘cd⇙ CFG_node nx"
by(fastforce intro:SDG_cdep_edge)
with ‹nx ∈ ⌊HRB_slice S⌋⇘CFG⇙› have "sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙"
by(fastforce elim!:combine_SDG_slices.cases
dest:SDG_edge_sum_SDG_edge cdep_slice1 cdep_slice2
intro:combine_SDG_slices.intros
simp:HRB_slice_def SDG_to_CFG_set_def)
with ‹valid_edge a›
have "obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙ = {sourcenode a}"
by(fastforce intro!:n_in_obs_intra)
with ‹m ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙›
‹nx ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙› ‹nx ≠ m›
show False by simp
qed
next
case False
with ‹m ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙›
have "m postdominates (sourcenode a)" by(rule obs_intra_postdominate)
with ‹¬ m postdominates (sourcenode a)› show False by simp
qed
qed
qed
lemma obs_intra_finite:"valid_node n ⟹ finite (obs_intra n ⌊HRB_slice S⌋⇘CFG⇙)"
by(fastforce dest:obs_intra_singleton_disj[of _ S])
lemma obs_intra_singleton:"valid_node n ⟹ card (obs_intra n ⌊HRB_slice S⌋⇘CFG⇙) ≤ 1"
by(fastforce dest:obs_intra_singleton_disj[of _ S])
lemma obs_intra_singleton_element:
"m ∈ obs_intra n ⌊HRB_slice S⌋⇘CFG⇙ ⟹ obs_intra n ⌊HRB_slice S⌋⇘CFG⇙ = {m}"
apply -
apply(frule in_obs_intra_valid)
apply(drule obs_intra_singleton_disj) apply auto
done
lemma obs_intra_the_element:
"m ∈ obs_intra n ⌊HRB_slice S⌋⇘CFG⇙ ⟹ (THE m. m ∈ obs_intra n ⌊HRB_slice S⌋⇘CFG⇙) = m"
by(fastforce dest:obs_intra_singleton_element)
lemma obs_singleton_element:
assumes "ms ∈ obs ns ⌊HRB_slice S⌋⇘CFG⇙" and "∀n ∈ set (tl ns). return_node n"
shows "obs ns ⌊HRB_slice S⌋⇘CFG⇙ = {ms}"
proof -
from ‹ms ∈ obs ns ⌊HRB_slice S⌋⇘CFG⇙› ‹∀n ∈ set (tl ns). return_node n›
obtain nsx n nsx' n' where "ns = nsx@n#nsx'" and "ms = n'#nsx'"
and split:"n' ∈ obs_intra n ⌊HRB_slice S⌋⇘CFG⇙"
"∀nx ∈ set nsx'. ∃nx'. call_of_return_node nx nx' ∧ nx' ∈ ⌊HRB_slice S⌋⇘CFG⇙"
"∀xs x xs'. nsx = xs@x#xs' ∧ obs_intra x ⌊HRB_slice S⌋⇘CFG⇙ ≠ {}
⟶ (∃x'' ∈ set (xs'@[n]). ∃nx. call_of_return_node x'' nx ∧
nx ∉ ⌊HRB_slice S⌋⇘CFG⇙)"
by(erule obsE)
from ‹n' ∈ obs_intra n ⌊HRB_slice S⌋⇘CFG⇙›
have "obs_intra n ⌊HRB_slice S⌋⇘CFG⇙ = {n'}"
by(fastforce intro!:obs_intra_singleton_element)
{ fix xs assume "xs ≠ ms" and "xs ∈ obs ns ⌊HRB_slice S⌋⇘CFG⇙"
from ‹xs ∈ obs ns ⌊HRB_slice S⌋⇘CFG⇙› ‹∀n ∈ set (tl ns). return_node n›
obtain zs z zs' z' where "ns = zs@z#zs'" and "xs = z'#zs'"
and "z' ∈ obs_intra z ⌊HRB_slice S⌋⇘CFG⇙"
and "∀z' ∈ set zs'. ∃nx'. call_of_return_node z' nx' ∧ nx' ∈ ⌊HRB_slice S⌋⇘CFG⇙"
and "∀xs x xs'. zs = xs@x#xs' ∧ obs_intra x ⌊HRB_slice S⌋⇘CFG⇙ ≠ {}
⟶ (∃x'' ∈ set (xs'@[z]). ∃nx. call_of_return_node x'' nx ∧
nx ∉ ⌊HRB_slice S⌋⇘CFG⇙)"
by(erule obsE)
with ‹ns = nsx@n#nsx'› split
have "nsx = zs ∧ n = z ∧ nsx' = zs'"
by -(rule obs_split_det[of _ _ _ _ _ _ "⌊HRB_slice S⌋⇘CFG⇙"],fastforce+)
with ‹obs_intra n ⌊HRB_slice S⌋⇘CFG⇙ = {n'}› ‹z' ∈ obs_intra z ⌊HRB_slice S⌋⇘CFG⇙›
have "z' = n'" by simp
with ‹xs ≠ ms› ‹ms = n'#nsx'› ‹xs = z'#zs'› ‹nsx = zs ∧ n = z ∧ nsx' = zs'›
have False by simp }
with ‹ms ∈ obs ns ⌊HRB_slice S⌋⇘CFG⇙› show ?thesis by fastforce
qed
lemma obs_finite:"∀n ∈ set (tl ns). return_node n
⟹ finite (obs ns ⌊HRB_slice S⌋⇘CFG⇙)"
by(cases "obs ns ⌊HRB_slice S⌋⇘CFG⇙ = {}",auto dest:obs_singleton_element[of _ _ S])
lemma obs_singleton:"∀n ∈ set (tl ns). return_node n
⟹ card (obs ns ⌊HRB_slice S⌋⇘CFG⇙) ≤ 1"
by(cases "obs ns ⌊HRB_slice S⌋⇘CFG⇙ = {}",auto dest:obs_singleton_element[of _ _ S])
lemma obs_the_element:
"⟦ms ∈ obs ns ⌊HRB_slice S⌋⇘CFG⇙; ∀n ∈ set (tl ns). return_node n⟧
⟹ (THE ms. ms ∈ obs ns ⌊HRB_slice S⌋⇘CFG⇙) = ms"
by(cases "obs ns ⌊HRB_slice S⌋⇘CFG⇙ = {}",auto dest:obs_singleton_element[of _ _ S])
end
end
Theory Distance
section ‹Distance of Paths›
theory Distance imports CFG begin
context CFG begin
inductive distance :: "'node ⇒ 'node ⇒ nat ⇒ bool"
where distanceI:
"⟦n -as→⇩ι* n'; length as = x; ∀as'. n -as'→⇩ι* n' ⟶ x ≤ length as'⟧
⟹ distance n n' x"
lemma every_path_distance:
assumes "n -as→⇩ι* n'"
obtains x where "distance n n' x" and "x ≤ length as"
proof(atomize_elim)
show "∃x. distance n n' x ∧ x ≤ length as"
proof(cases "∃as'. n -as'→⇩ι* n' ∧
(∀asx. n -asx→⇩ι* n' ⟶ length as' ≤ length asx)")
case True
then obtain as'
where "n -as'→⇩ι* n' ∧ (∀asx. n -asx→⇩ι* n' ⟶ length as' ≤ length asx)"
by blast
hence "n -as'→⇩ι* n'" and all:"∀asx. n -asx→⇩ι* n' ⟶ length as' ≤ length asx"
by simp_all
hence "distance n n' (length as')" by(fastforce intro:distanceI)
from ‹n -as→⇩ι* n'› all have "length as' ≤ length as" by fastforce
with ‹distance n n' (length as')› show ?thesis by blast
next
case False
hence all:"∀as'. n -as'→⇩ι* n' ⟶ (∃asx. n -asx→⇩ι* n' ∧ length as' > length asx)"
by fastforce
have "wf (measure length)" by simp
from ‹n -as→⇩ι* n'› have "as ∈ {as. n -as→⇩ι* n'}" by simp
with ‹wf (measure length)› obtain as' where "as' ∈ {as. n -as→⇩ι* n'}"
and notin:"⋀as''. (as'',as') ∈ (measure length) ⟹ as'' ∉ {as. n -as→⇩ι* n'}"
by(erule wfE_min)
from ‹as' ∈ {as. n -as→⇩ι* n'}› have "n -as'→⇩ι* n'" by simp
with all obtain asx where "n -asx→⇩ι* n'"
and "length as' > length asx"
by blast
with notin have "asx ∉ {as. n -as→⇩ι* n'}" by simp
hence "¬ n -asx→⇩ι* n'" by simp
with ‹n -asx→⇩ι* n'› have False by simp
thus ?thesis by simp
qed
qed
lemma distance_det:
"⟦distance n n' x; distance n n' x'⟧ ⟹ x = x'"
apply(erule distance.cases)+ apply clarsimp
apply(erule_tac x="asa" in allE) apply(erule_tac x="as" in allE)
by simp
lemma only_one_SOME_dist_edge:
assumes "valid_edge a" and "intra_kind(kind a)" and "distance (targetnode a) n' x"
shows "∃!a'. sourcenode a = sourcenode a' ∧ distance (targetnode a') n' x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = (SOME nx. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') n' x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = nx)"
proof(rule ex_ex1I)
show "∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') n' x ∧ valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = (SOME nx. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') n' x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = nx)"
proof -
have "(∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') n' x ∧ valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = (SOME nx. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') n' x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = nx)) =
(∃nx. ∃a'. sourcenode a = sourcenode a' ∧ distance (targetnode a') n' x ∧
valid_edge a' ∧ intra_kind(kind a') ∧ targetnode a' = nx)"
apply(unfold some_eq_ex[of "λnx. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') n' x ∧ valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = nx"])
by simp
also have "…"
using ‹valid_edge a› ‹intra_kind(kind a)› ‹distance (targetnode a) n' x›
by blast
finally show ?thesis .
qed
next
fix a' ax
assume "sourcenode a = sourcenode a' ∧
distance (targetnode a') n' x ∧ valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = (SOME nx. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') n' x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = nx)"
and "sourcenode a = sourcenode ax ∧
distance (targetnode ax) n' x ∧ valid_edge ax ∧ intra_kind(kind ax) ∧
targetnode ax = (SOME nx. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') n' x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = nx)"
thus "a' = ax" by(fastforce intro!:edge_det)
qed
lemma distance_successor_distance:
assumes "distance n n' x" and "x ≠ 0"
obtains a where "valid_edge a" and "n = sourcenode a" and "intra_kind(kind a)"
and "distance (targetnode a) n' (x - 1)"
and "targetnode a = (SOME nx. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') n' (x - 1) ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = nx)"
proof(atomize_elim)
show "∃a. valid_edge a ∧ n = sourcenode a ∧ intra_kind(kind a) ∧
distance (targetnode a) n' (x - 1) ∧
targetnode a = (SOME nx. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') n' (x - 1) ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = nx)"
proof(rule ccontr)
assume "¬ (∃a. valid_edge a ∧ n = sourcenode a ∧ intra_kind(kind a) ∧
distance (targetnode a) n' (x - 1) ∧
targetnode a = (SOME nx. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') n' (x - 1) ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = nx))"
hence imp:"∀a. valid_edge a ∧ n = sourcenode a ∧ intra_kind(kind a) ∧
targetnode a = (SOME nx. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') n' (x - 1) ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = nx)
⟶ ¬ distance (targetnode a) n' (x - 1)" by blast
from ‹distance n n' x› obtain as where "n -as→⇩ι* n'" and "x = length as"
and all:"∀as'. n -as'→⇩ι* n' ⟶ x ≤ length as'"
by(auto elim:distance.cases)
from ‹n -as→⇩ι* n'› have "n -as→* n'" and "∀a ∈ set as. intra_kind(kind a)"
by(simp_all add:intra_path_def)
from this ‹x = length as› all imp show False
proof(induct rule:path.induct)
case (empty_path n)
from ‹x = length []› ‹x ≠ 0› show False by simp
next
case (Cons_path n'' as n' a n)
note imp = ‹∀a. valid_edge a ∧ n = sourcenode a ∧ intra_kind (kind a) ∧
targetnode a = (SOME nx. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') n' (x - 1) ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = nx)
⟶ ¬ distance (targetnode a) n' (x - 1)›
note all = ‹∀as'. n -as'→⇩ι* n' ⟶ x ≤ length as'›
from ‹∀a∈set (a#as). intra_kind (kind a)›
have "intra_kind (kind a)" and "∀a∈set as. intra_kind (kind a)"
by simp_all
from ‹n'' -as→* n'› ‹∀a∈set as. intra_kind (kind a)›
have "n'' -as→⇩ι* n'" by(simp add:intra_path_def)
then obtain y where "distance n'' n' y"
and "y ≤ length as" by(erule every_path_distance)
from ‹distance n'' n' y› obtain as' where "n'' -as'→⇩ι* n'"
and "y = length as'" by(auto elim:distance.cases)
hence "n'' -as'→* n'" and "∀a∈set as'. intra_kind (kind a)"
by(simp_all add:intra_path_def)
show False
proof(cases "y < length as")
case True
from ‹valid_edge a› ‹sourcenode a = n› ‹targetnode a = n''› ‹n'' -as'→* n'›
have "n -a#as'→* n'" by -(rule path.Cons_path)
with ‹∀a∈set as'. intra_kind (kind a)› ‹intra_kind (kind a)›
have "n -a#as'→⇩ι* n'" by(simp add:intra_path_def)
with all have "x ≤ length (a#as')" by blast
with ‹x = length (a#as)› True ‹y = length as'› show False by simp
next
case False
with ‹y ≤ length as› ‹x = length (a#as)› have "y = x - 1" by simp
from ‹targetnode a = n''› ‹distance n'' n' y›
have "distance (targetnode a) n' y" by simp
with ‹valid_edge a› ‹intra_kind(kind a)›
obtain a' where "sourcenode a = sourcenode a'"
and "distance (targetnode a') n' y" and "valid_edge a'"
and "intra_kind(kind a')"
and "targetnode a' = (SOME nx. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') n' y ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = nx)"
by(auto dest:only_one_SOME_dist_edge)
with imp ‹sourcenode a = n› ‹y = x - 1› show False by fastforce
qed
qed
qed
qed
end
end
Theory Slice
section ‹Static backward slice›
theory Slice imports SCDObservable Distance begin
context SDG begin
subsection ‹Preliminary definitions on the parameter nodes for defining
sliced call and return edges›
fun csppa :: "'node ⇒ 'node SDG_node set ⇒ nat ⇒
((('var ⇀ 'val) ⇒ 'val option) list) ⇒ ((('var ⇀ 'val) ⇒ 'val option) list)"
where "csppa m S x [] = []"
| "csppa m S x (f#fs) =
(if Formal_in(m,x) ∉ S then Map.empty else f)#csppa m S (Suc x) fs"
definition cspp :: "'node ⇒ 'node SDG_node set ⇒
((('var ⇀ 'val) ⇒ 'val option) list) ⇒ ((('var ⇀ 'val) ⇒ 'val option) list)"
where "cspp m S fs ≡ csppa m S 0 fs"
lemma [simp]: "length (csppa m S x fs) = length fs"
by(induct fs arbitrary:x)(auto)
lemma [simp]: "length (cspp m S fs) = length fs"
by(simp add:cspp_def)
lemma csppa_Formal_in_notin_slice:
"⟦x < length fs; Formal_in(m,x + i) ∉ S⟧
⟹ (csppa m S i fs)!x = Map.empty"
by(induct fs arbitrary:i x,auto simp:nth_Cons')
lemma csppa_Formal_in_in_slice:
"⟦x < length fs; Formal_in(m,x + i) ∈ S⟧
⟹ (csppa m S i fs)!x = fs!x"
by(induct fs arbitrary:i x,auto simp:nth_Cons')
definition map_merge :: "('var ⇀ 'val) ⇒ ('var ⇀ 'val) ⇒ (nat ⇒ bool) ⇒
'var list ⇒ ('var ⇀ 'val)"
where "map_merge f g Q xs ≡ (λV. if (∃i. i < length xs ∧ xs!i = V ∧ Q i) then g V
else f V)"
definition rspp :: "'node ⇒ 'node SDG_node set ⇒ 'var list ⇒
('var ⇀ 'val) ⇒ ('var ⇀ 'val) ⇒ ('var ⇀ 'val)"
where "rspp m S xs f g ≡ map_merge f (Map.empty(ParamDefs m [:=] map g xs))
(λi. Actual_out(m,i) ∈ S) (ParamDefs m)"
lemma rspp_Actual_out_in_slice:
assumes "x < length (ParamDefs (targetnode a))" and "valid_edge a"
and "length (ParamDefs (targetnode a)) = length xs"
and "Actual_out (targetnode a,x) ∈ S"
shows "(rspp (targetnode a) S xs f g) ((ParamDefs (targetnode a))!x) = g(xs!x)"
proof -
from ‹valid_edge a› have "distinct(ParamDefs (targetnode a))"
by(rule distinct_ParamDefs)
from ‹x < length (ParamDefs (targetnode a))›
‹length (ParamDefs (targetnode a)) = length xs›
‹distinct(ParamDefs (targetnode a))›
have "(Map.empty(ParamDefs (targetnode a) [:=] map g xs))
((ParamDefs (targetnode a))!x) = (map g xs)!x"
by(fastforce intro:fun_upds_nth)
with ‹Actual_out(targetnode a,x) ∈ S› ‹x < length (ParamDefs (targetnode a))›
‹length (ParamDefs (targetnode a)) = length xs› show ?thesis
by(fastforce simp:rspp_def map_merge_def)
qed
lemma rspp_Actual_out_notin_slice:
assumes "x < length (ParamDefs (targetnode a))" and "valid_edge a"
and "length (ParamDefs (targetnode a)) = length xs"
and "Actual_out((targetnode a),x) ∉ S"
shows "(rspp (targetnode a) S xs f g) ((ParamDefs (targetnode a))!x) =
f((ParamDefs (targetnode a))!x)"
proof -
from ‹valid_edge a› have "distinct(ParamDefs (targetnode a))"
by(rule distinct_ParamDefs)
from ‹x < length (ParamDefs (targetnode a))›
‹length (ParamDefs (targetnode a)) = length xs›
‹distinct(ParamDefs (targetnode a))›
have "(Map.empty(ParamDefs (targetnode a) [:=] map g xs))
((ParamDefs (targetnode a))!x) = (map g xs)!x"
by(fastforce intro:fun_upds_nth)
with ‹Actual_out((targetnode a),x) ∉ S› ‹distinct(ParamDefs (targetnode a))›
‹x < length (ParamDefs (targetnode a))›
show ?thesis by(fastforce simp:rspp_def map_merge_def nth_eq_iff_index_eq)
qed
subsection ‹Defining the sliced edge kinds›
primrec slice_kind_aux :: "'node ⇒ 'node ⇒ 'node SDG_node set ⇒
('var,'val,'ret,'pname) edge_kind ⇒ ('var,'val,'ret,'pname) edge_kind"
where "slice_kind_aux m m' S ⇑f = (if m ∈ ⌊S⌋⇘CFG⇙ then ⇑f else ⇑id)"
| "slice_kind_aux m m' S (Q)⇩√ = (if m ∈ ⌊S⌋⇘CFG⇙ then (Q)⇩√ else
(if obs_intra m ⌊S⌋⇘CFG⇙ = {} then
(let mex = (THE mex. method_exit mex ∧ get_proc m = get_proc mex) in
(if (∃x. distance m' mex x ∧ distance m mex (x + 1) ∧
(m' = (SOME mx'. ∃a'. m = sourcenode a' ∧
distance (targetnode a') mex x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = mx')))
then (λcf. True)⇩√ else (λcf. False)⇩√))
else (let mx = THE mx. mx ∈ obs_intra m ⌊S⌋⇘CFG⇙ in
(if (∃x. distance m' mx x ∧ distance m mx (x + 1) ∧
(m' = (SOME mx'. ∃a'. m = sourcenode a' ∧
distance (targetnode a') mx x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = mx')))
then (λcf. True)⇩√ else (λcf. False)⇩√))))"
| "slice_kind_aux m m' S (Q:r↪⇘p⇙fs) = (if m ∈ ⌊S⌋⇘CFG⇙ then (Q:r↪⇘p⇙(cspp m' S fs))
else ((λcf. False):r↪⇘p⇙fs))"
| "slice_kind_aux m m' S (Q↩⇘p⇙f) = (if m ∈ ⌊S⌋⇘CFG⇙ then
(let outs = THE outs. ∃ins. (p,ins,outs) ∈ set procs in
(Q↩⇘p⇙(λcf cf'. rspp m' S outs cf' cf)))
else ((λcf. True)↩⇘p⇙(λcf cf'. cf')))"
definition slice_kind :: "'node SDG_node set ⇒ 'edge ⇒
('var,'val,'ret,'pname) edge_kind"
where "slice_kind S a ≡
slice_kind_aux (sourcenode a) (targetnode a) (HRB_slice S) (kind a)"
definition slice_kinds :: "'node SDG_node set ⇒ 'edge list ⇒
('var,'val,'ret,'pname) edge_kind list"
where "slice_kinds S as ≡ map (slice_kind S) as"
lemma slice_intra_kind_in_slice:
"⟦sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙; intra_kind (kind a)⟧
⟹ slice_kind S a = kind a"
by(fastforce simp:intra_kind_def slice_kind_def)
lemma slice_kind_Upd:
"⟦sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙; kind a = ⇑f⟧ ⟹ slice_kind S a = ⇑id"
by(simp add:slice_kind_def)
lemma slice_kind_Pred_empty_obs_nearer_SOME:
assumes "sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙" and "kind a = (Q)⇩√"
and "obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙ = {}"
and "method_exit mex" and "get_proc (sourcenode a) = get_proc mex"
and "distance (targetnode a) mex x" and "distance (sourcenode a) mex (x + 1)"
and "targetnode a = (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') mex x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = n')"
shows "slice_kind S a = (λs. True)⇩√"
proof -
from ‹method_exit mex› ‹get_proc (sourcenode a) = get_proc mex›
have "mex = (THE mex. method_exit mex ∧ get_proc (sourcenode a) = get_proc mex)"
by(auto intro!:the_equality[THEN sym] intro:method_exit_unique)
with ‹sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙› ‹kind a = (Q)⇩√›
‹obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙ = {}›
have "slice_kind S a =
(if (∃x. distance (targetnode a) mex x ∧ distance (sourcenode a) mex (x + 1) ∧
(targetnode a = (SOME mx'. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') mex x ∧ valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = mx'))) then (λcf. True)⇩√ else (λcf. False)⇩√)"
by(simp add:slice_kind_def Let_def)
with ‹distance (targetnode a) mex x› ‹distance (sourcenode a) mex (x + 1)›
‹targetnode a = (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') mex x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = n')›
show ?thesis by fastforce
qed
lemma slice_kind_Pred_empty_obs_nearer_not_SOME:
assumes "sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙" and "kind a = (Q)⇩√"
and "obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙ = {}"
and "method_exit mex" and "get_proc (sourcenode a) = get_proc mex"
and "distance (targetnode a) mex x" and "distance (sourcenode a) mex (x + 1)"
and "targetnode a ≠ (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') mex x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = n')"
shows "slice_kind S a = (λs. False)⇩√"
proof -
from ‹method_exit mex› ‹get_proc (sourcenode a) = get_proc mex›
have "mex = (THE mex. method_exit mex ∧ get_proc (sourcenode a) = get_proc mex)"
by(auto intro!:the_equality[THEN sym] intro:method_exit_unique)
with ‹sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙› ‹kind a = (Q)⇩√›
‹obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙ = {}›
have "slice_kind S a =
(if (∃x. distance (targetnode a) mex x ∧ distance (sourcenode a) mex (x + 1) ∧
(targetnode a = (SOME mx'. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') mex x ∧ valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = mx'))) then (λcf. True)⇩√ else (λcf. False)⇩√)"
by(simp add:slice_kind_def Let_def)
with ‹distance (targetnode a) mex x› ‹distance (sourcenode a) mex (x + 1)›
‹targetnode a ≠ (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') mex x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = n')›
show ?thesis by(auto dest:distance_det)
qed
lemma slice_kind_Pred_empty_obs_not_nearer:
assumes "sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙" and "kind a = (Q)⇩√"
and "obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙ = {}"
and "method_exit mex" and "get_proc (sourcenode a) = get_proc mex"
and dist:"distance (sourcenode a) mex (x + 1)" "¬ distance (targetnode a) mex x"
shows "slice_kind S a = (λs. False)⇩√"
proof -
from ‹method_exit mex› ‹get_proc (sourcenode a) = get_proc mex›
have "mex = (THE mex. method_exit mex ∧ get_proc (sourcenode a) = get_proc mex)"
by(auto intro!:the_equality[THEN sym] intro:method_exit_unique)
moreover
from dist have "¬ (∃x. distance (targetnode a) mex x ∧
distance (sourcenode a) mex (x + 1))"
by(fastforce dest:distance_det)
ultimately show ?thesis using assms by(auto simp:slice_kind_def Let_def)
qed
lemma slice_kind_Pred_obs_nearer_SOME:
assumes "sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙" and "kind a = (Q)⇩√"
and "m ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙"
and "distance (targetnode a) m x" "distance (sourcenode a) m (x + 1)"
and "targetnode a = (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') m x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = n')"
shows "slice_kind S a = (λs. True)⇩√"
proof -
from ‹m ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙›
have "m = (THE m. m ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙)"
by(rule obs_intra_the_element[THEN sym])
with assms show ?thesis by(auto simp:slice_kind_def Let_def)
qed
lemma slice_kind_Pred_obs_nearer_not_SOME:
assumes "sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙" and "kind a = (Q)⇩√"
and "m ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙"
and "distance (targetnode a) m x" "distance (sourcenode a) m (x + 1)"
and "targetnode a ≠ (SOME nx'. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') m x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = nx')"
shows "slice_kind S a = (λs. False)⇩√"
proof -
from ‹m ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙›
have "m = (THE m. m ∈ obs_intra (sourcenode a) (⌊HRB_slice S⌋⇘CFG⇙))"
by(rule obs_intra_the_element[THEN sym])
with assms show ?thesis by(auto dest:distance_det simp:slice_kind_def Let_def)
qed
lemma slice_kind_Pred_obs_not_nearer:
assumes "sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙" and "kind a = (Q)⇩√"
and in_obs:"m ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙"
and dist:"distance (sourcenode a) m (x + 1)"
"¬ distance (targetnode a) m x"
shows "slice_kind S a = (λs. False)⇩√"
proof -
from in_obs have the:"m = (THE m. m ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙)"
by(rule obs_intra_the_element[THEN sym])
from dist have "¬ (∃x. distance (targetnode a) m x ∧
distance (sourcenode a) m (x + 1))"
by(fastforce dest:distance_det)
with ‹sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙› ‹kind a = (Q)⇩√› in_obs the show ?thesis
by(auto simp:slice_kind_def Let_def)
qed
lemma kind_Predicate_notin_slice_slice_kind_Predicate:
assumes "sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙" and "valid_edge a" and "kind a = (Q)⇩√"
obtains Q' where "slice_kind S a = (Q')⇩√" and "Q' = (λs. False) ∨ Q' = (λs. True)"
proof(atomize_elim)
show "∃Q'. slice_kind S a = (Q')⇩√ ∧ (Q' = (λs. False) ∨ Q' = (λs. True))"
proof(cases "obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙ = {}")
case True
from ‹valid_edge a› have "valid_node (sourcenode a)" by simp
then obtain as where "sourcenode a -as→⇩√* (_Exit_)" by(fastforce dest:Exit_path)
then obtain as' mex where "sourcenode a -as'→⇩ι* mex" and "method_exit mex"
by -(erule valid_Exit_path_intra_path)
from ‹sourcenode a -as'→⇩ι* mex› have "get_proc (sourcenode a) = get_proc mex"
by(rule intra_path_get_procs)
show ?thesis
proof(cases "∃x. distance (targetnode a) mex x ∧
distance (sourcenode a) mex (x + 1)")
case True
then obtain x where "distance (targetnode a) mex x"
and "distance (sourcenode a) mex (x + 1)" by blast
show ?thesis
proof(cases "targetnode a = (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') mex x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = n')")
case True
with ‹sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙› ‹kind a = (Q)⇩√›
‹obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙ = {}›
‹method_exit mex› ‹get_proc (sourcenode a) = get_proc mex›
‹distance (targetnode a) mex x› ‹distance (sourcenode a) mex (x + 1)›
have "slice_kind S a = (λs. True)⇩√"
by(rule slice_kind_Pred_empty_obs_nearer_SOME)
thus ?thesis by simp
next
case False
with ‹sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙› ‹kind a = (Q)⇩√›
‹obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙ = {}›
‹method_exit mex› ‹get_proc (sourcenode a) = get_proc mex›
‹distance (targetnode a) mex x› ‹distance (sourcenode a) mex (x + 1)›
have "slice_kind S a = (λs. False)⇩√"
by(rule slice_kind_Pred_empty_obs_nearer_not_SOME)
thus ?thesis by simp
qed
next
case False
from ‹method_exit mex› ‹get_proc (sourcenode a) = get_proc mex›
have "mex = (THE mex. method_exit mex ∧ get_proc (sourcenode a) = get_proc mex)"
by(auto intro!:the_equality[THEN sym] intro:method_exit_unique)
with ‹sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙› ‹kind a = (Q)⇩√›
‹obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙ = {}› False
have "slice_kind S a = (λs. False)⇩√"
by(auto simp:slice_kind_def Let_def)
thus ?thesis by simp
qed
next
case False
then obtain m where "m ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙" by blast
show ?thesis
proof(cases "∃x. distance (targetnode a) m x ∧
distance (sourcenode a) m (x + 1)")
case True
then obtain x where "distance (targetnode a) m x"
and "distance (sourcenode a) m (x + 1)" by blast
show ?thesis
proof(cases "targetnode a = (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') m x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = n')")
case True
with ‹sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙› ‹kind a = (Q)⇩√›
‹m ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙›
‹distance (targetnode a) m x› ‹distance (sourcenode a) m (x + 1)›
have "slice_kind S a = (λs. True)⇩√"
by(rule slice_kind_Pred_obs_nearer_SOME)
thus ?thesis by simp
next
case False
with ‹sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙› ‹kind a = (Q)⇩√›
‹m ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙›
‹distance (targetnode a) m x› ‹distance (sourcenode a) m (x + 1)›
have "slice_kind S a = (λs. False)⇩√"
by(rule slice_kind_Pred_obs_nearer_not_SOME)
thus ?thesis by simp
qed
next
case False
from ‹m ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙›
have "m = (THE m. m ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙)"
by(rule obs_intra_the_element[THEN sym])
with ‹sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙› ‹kind a = (Q)⇩√› False
‹m ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙›
have "slice_kind S a = (λs. False)⇩√"
by(auto simp:slice_kind_def Let_def)
thus ?thesis by simp
qed
qed
qed
lemma slice_kind_Call:
"⟦sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙; kind a = Q:r↪⇘p⇙fs⟧
⟹ slice_kind S a = (λcf. False):r↪⇘p⇙fs"
by(simp add:slice_kind_def)
lemma slice_kind_Call_in_slice:
"⟦sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙; kind a = Q:r↪⇘p⇙fs⟧
⟹ slice_kind S a = Q:r↪⇘p⇙(cspp (targetnode a) (HRB_slice S) fs)"
by(simp add:slice_kind_def)
lemma slice_kind_Call_in_slice_Formal_in_not:
assumes "sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙" and "kind a = Q:r↪⇘p⇙fs"
and "∀x < length fs. Formal_in(targetnode a,x) ∉ HRB_slice S"
shows "slice_kind S a = Q:r↪⇘p⇙replicate (length fs) Map.empty"
proof -
from ‹sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙› ‹kind a = Q:r↪⇘p⇙fs›
have "slice_kind S a = Q:r↪⇘p⇙(cspp (targetnode a) (HRB_slice S) fs)"
by(simp add:slice_kind_def)
from ‹∀x < length fs. Formal_in(targetnode a,x) ∉ HRB_slice S›
have "cspp (targetnode a) (HRB_slice S) fs = replicate (length fs) Map.empty"
by(fastforce intro:nth_equalityI csppa_Formal_in_notin_slice simp:cspp_def)
with ‹slice_kind S a = Q:r↪⇘p⇙(cspp (targetnode a) (HRB_slice S) fs)›
show ?thesis by simp
qed
lemma slice_kind_Call_in_slice_Formal_in_also:
assumes "sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙" and "kind a = Q:r↪⇘p⇙fs"
and "∀x < length fs. Formal_in(targetnode a,x) ∈ HRB_slice S"
shows "slice_kind S a = Q:r↪⇘p⇙fs"
proof -
from ‹sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙› ‹kind a = Q:r↪⇘p⇙fs›
have "slice_kind S a = Q:r↪⇘p⇙(cspp (targetnode a) (HRB_slice S) fs)"
by(simp add:slice_kind_def)
from ‹∀x < length fs. Formal_in(targetnode a,x) ∈ HRB_slice S›
have "cspp (targetnode a) (HRB_slice S) fs = fs"
by(fastforce intro:nth_equalityI csppa_Formal_in_in_slice simp:cspp_def)
with ‹slice_kind S a = Q:r↪⇘p⇙(cspp (targetnode a) (HRB_slice S) fs)›
show ?thesis by simp
qed
lemma slice_kind_Call_intra_notin_slice:
assumes "sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙" and "valid_edge a"
and "intra_kind (kind a)" and "valid_edge a'" and "kind a' = Q:r↪⇘p⇙fs"
and "sourcenode a' = sourcenode a"
shows "slice_kind S a = (λs. True)⇩√"
proof -
from ‹valid_edge a'› ‹kind a' = Q:r↪⇘p⇙fs› obtain a''
where "a'' ∈ get_return_edges a'"
by(fastforce dest:get_return_edge_call)
with ‹valid_edge a'› obtain ax where "valid_edge ax"
and "sourcenode ax = sourcenode a'" and " targetnode ax = targetnode a''"
and "kind ax = (λcf. False)⇩√"
by(fastforce dest:call_return_node_edge)
from ‹valid_edge a'› ‹kind a' = Q:r↪⇘p⇙fs›
have "∃!a''. valid_edge a'' ∧ sourcenode a'' = sourcenode a' ∧
intra_kind(kind a'')"
by(rule call_only_one_intra_edge)
with ‹valid_edge a› ‹sourcenode a' = sourcenode a› ‹intra_kind (kind a)›
have all:"∀a''. valid_edge a'' ∧ sourcenode a'' = sourcenode a' ∧
intra_kind(kind a'') ⟶ a'' = a" by fastforce
with ‹valid_edge ax› ‹sourcenode ax = sourcenode a'› ‹kind ax = (λcf. False)⇩√›
have [simp]:"ax = a" by(fastforce simp:intra_kind_def)
show ?thesis
proof(cases "obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙ = {}")
case True
from ‹valid_edge a› have "valid_node (sourcenode a)" by simp
then obtain asx where "sourcenode a -asx→⇩√* (_Exit_)" by(fastforce dest:Exit_path)
then obtain as pex where "sourcenode a-as→⇩ι* pex" and "method_exit pex"
by -(erule valid_Exit_path_intra_path)
from ‹sourcenode a-as→⇩ι* pex› have "get_proc (sourcenode a) = get_proc pex"
by(rule intra_path_get_procs)
from ‹sourcenode a-as→⇩ι* pex› obtain x where "distance (sourcenode a) pex x"
and "x ≤ length as" by(erule every_path_distance)
from ‹method_exit pex› have "sourcenode a ≠ pex"
proof(rule method_exit_cases)
assume "pex = (_Exit_)"
show ?thesis
proof
assume "sourcenode a = pex"
with ‹pex = (_Exit_)› have "sourcenode a = (_Exit_)" by simp
with ‹valid_edge a› show False by(rule Exit_source)
qed
next
fix ax Qx px fx
assume "pex = sourcenode ax" and "valid_edge ax" and "kind ax = Qx↩⇘px⇙fx"
hence "∀a'. valid_edge a' ∧ sourcenode a' = sourcenode ax ⟶
(∃Qx' fx'. kind a' = Qx'↩⇘px⇙fx')" by -(rule return_edges_only)
with ‹valid_edge a› ‹intra_kind (kind a)› ‹pex = sourcenode ax›
show ?thesis by(fastforce simp:intra_kind_def)
qed
have "x ≠ 0"
proof
assume "x = 0"
with ‹distance (sourcenode a) pex x› have "sourcenode a = pex"
by(fastforce elim:distance.cases simp:intra_path_def)
with ‹sourcenode a ≠ pex› show False by simp
qed
with ‹distance (sourcenode a) pex x› obtain ax' where "valid_edge ax'"
and "sourcenode a = sourcenode ax'" and "intra_kind(kind ax')"
and "distance (targetnode ax') pex (x - 1)"
and Some:"targetnode ax' = (SOME nx. ∃a'. sourcenode ax' = sourcenode a' ∧
distance (targetnode a') pex (x - 1) ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = nx)"
by(erule distance_successor_distance)
from ‹valid_edge ax'› ‹sourcenode a = sourcenode ax'› ‹intra_kind(kind ax')›
‹sourcenode a' = sourcenode a› all
have [simp]:"ax' = a" by fastforce
from ‹sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙› ‹kind ax = (λcf. False)⇩√›
True ‹method_exit pex› ‹get_proc (sourcenode a) = get_proc pex› ‹x ≠ 0›
‹distance (targetnode ax') pex (x - 1)› ‹distance (sourcenode a) pex x› Some
show ?thesis by(fastforce elim:slice_kind_Pred_empty_obs_nearer_SOME)
next
case False
then obtain m where "m ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙" by fastforce
then obtain as where "sourcenode a-as→⇩ι* m" and "m ∈ ⌊HRB_slice S⌋⇘CFG⇙"
by -(erule obs_intraE)
from ‹sourcenode a-as→⇩ι* m› obtain x where "distance (sourcenode a) m x"
and "x ≤ length as" by(erule every_path_distance)
from ‹sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙› ‹m ∈ ⌊HRB_slice S⌋⇘CFG⇙›
have "sourcenode a ≠ m" by fastforce
have "x ≠ 0"
proof
assume "x = 0"
with ‹distance (sourcenode a) m x› have "sourcenode a = m"
by(fastforce elim:distance.cases simp:intra_path_def)
with ‹sourcenode a ≠ m› show False by simp
qed
with ‹distance (sourcenode a) m x› obtain ax' where "valid_edge ax'"
and "sourcenode a = sourcenode ax'" and "intra_kind(kind ax')"
and "distance (targetnode ax') m (x - 1)"
and Some:"targetnode ax' = (SOME nx. ∃a'. sourcenode ax' = sourcenode a' ∧
distance (targetnode a') m (x - 1) ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = nx)"
by(erule distance_successor_distance)
from ‹valid_edge ax'› ‹sourcenode a = sourcenode ax'› ‹intra_kind(kind ax')›
‹sourcenode a' = sourcenode a› all
have [simp]:"ax' = a" by fastforce
from ‹sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙› ‹kind ax = (λcf. False)⇩√›
‹m ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙› ‹x ≠ 0›
‹distance (targetnode ax') m (x - 1)› ‹distance (sourcenode a) m x› Some
show ?thesis by(fastforce elim:slice_kind_Pred_obs_nearer_SOME)
qed
qed
lemma slice_kind_Return:
"⟦sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙; kind a = Q↩⇘p⇙f⟧
⟹ slice_kind S a = (λcf. True)↩⇘p⇙(λcf cf'. cf')"
by(simp add:slice_kind_def)
lemma slice_kind_Return_in_slice:
"⟦sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙; valid_edge a; kind a = Q↩⇘p⇙f;
(p,ins,outs) ∈ set procs⟧
⟹ slice_kind S a = Q↩⇘p⇙(λcf cf'. rspp (targetnode a) (HRB_slice S) outs cf' cf)"
by(simp add:slice_kind_def,unfold formal_out_THE,simp)
lemma length_transfer_kind_slice_kind:
assumes "valid_edge a" and "length s⇩1 = length s⇩2"
and "transfer (kind a) s⇩1 = s⇩1'" and "transfer (slice_kind S a) s⇩2 = s⇩2'"
shows "length s⇩1' = length s⇩2'"
proof(cases "kind a" rule:edge_kind_cases)
case Intra
show ?thesis
proof(cases "sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙")
case True
with Intra assms show ?thesis
by(cases s⇩1)(cases s⇩2,auto dest:slice_intra_kind_in_slice simp:intra_kind_def)+
next
case False
with Intra assms show ?thesis
by(cases s⇩1)(cases s⇩2,auto dest:slice_kind_Upd
elim:kind_Predicate_notin_slice_slice_kind_Predicate simp:intra_kind_def)+
qed
next
case (Call Q r p fs)
show ?thesis
proof(cases "sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙")
case True
with Call assms show ?thesis
by(cases s⇩1)(cases s⇩2,auto dest:slice_kind_Call_in_slice)+
next
case False
with Call assms show ?thesis
by(cases s⇩1)(cases s⇩2,auto dest:slice_kind_Call)+
qed
next
case (Return Q p f)
show ?thesis
proof(cases "sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙")
case True
from Return ‹valid_edge a› obtain a' Q' r fs
where "valid_edge a'" and "kind a' = Q':r↪⇘p⇙fs"
by -(drule return_needs_call,auto)
then obtain ins outs where "(p,ins,outs) ∈ set procs"
by(fastforce dest!:callee_in_procs)
with True ‹valid_edge a› Return assms show ?thesis
by(cases s⇩1)(cases s⇩2,auto dest:slice_kind_Return_in_slice split:list.split)+
next
case False
with Return assms show ?thesis
by(cases s⇩1)(cases s⇩2,auto dest:slice_kind_Return split:list.split)+
qed
qed
subsection ‹The sliced graph of a deterministic CFG is still deterministic›
lemma only_one_SOME_edge:
assumes "valid_edge a" and "intra_kind(kind a)" and "distance (targetnode a) mex x"
shows "∃!a'. sourcenode a = sourcenode a' ∧ distance (targetnode a') mex x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') mex x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = n')"
proof(rule ex_ex1I)
show "∃a'. sourcenode a = sourcenode a' ∧ distance (targetnode a') mex x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') mex x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = n')"
proof -
have "(∃a'. sourcenode a = sourcenode a' ∧ distance (targetnode a') mex x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') mex x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = n')) =
(∃n'. ∃a'. sourcenode a = sourcenode a' ∧ distance (targetnode a') mex x ∧
valid_edge a' ∧ intra_kind(kind a') ∧ targetnode a' = n')"
apply(unfold some_eq_ex[of "λn'. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') mex x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = n'"])
by simp
also have "…"
using ‹valid_edge a› ‹intra_kind(kind a)› ‹distance (targetnode a) mex x›
by blast
finally show ?thesis .
qed
next
fix a' ax
assume "sourcenode a = sourcenode a' ∧ distance (targetnode a') mex x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') mex x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = n')"
and "sourcenode a = sourcenode ax ∧ distance (targetnode ax) mex x ∧
valid_edge ax ∧ intra_kind(kind ax) ∧
targetnode ax = (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') mex x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = n')"
thus "a' = ax" by(fastforce intro!:edge_det)
qed
lemma slice_kind_only_one_True_edge:
assumes "sourcenode a = sourcenode a'" and "targetnode a ≠ targetnode a'"
and "valid_edge a" and "valid_edge a'" and "intra_kind (kind a)"
and "intra_kind (kind a')" and "slice_kind S a = (λs. True)⇩√"
shows "slice_kind S a' = (λs. False)⇩√"
proof -
from assms obtain Q Q' where "kind a = (Q)⇩√"
and "kind a' = (Q')⇩√" and det:"∀s. (Q s ⟶ ¬ Q' s) ∧ (Q' s ⟶ ¬ Q s)"
by(auto dest:deterministic)
show ?thesis
proof(cases "sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙")
case True
with ‹slice_kind S a = (λs. True)⇩√› ‹kind a = (Q)⇩√› have "Q = (λs. True)"
by(simp add:slice_kind_def Let_def)
with det have "Q' = (λs. False)" by(simp add:fun_eq_iff)
with True ‹kind a' = (Q')⇩√› ‹sourcenode a = sourcenode a'› show ?thesis
by(simp add:slice_kind_def Let_def)
next
case False
hence "sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙" by simp
thus ?thesis
proof(cases "obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙ = {}")
case True
with ‹sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙› ‹slice_kind S a = (λs. True)⇩√›
‹kind a = (Q)⇩√›
obtain mex x where mex:"mex = (THE mex. method_exit mex ∧
get_proc (sourcenode a) = get_proc mex)"
and dist:"distance (targetnode a) mex x" "distance (sourcenode a) mex (x + 1)"
and target:"targetnode a = (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') mex x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = n')"
by(auto simp:slice_kind_def Let_def fun_eq_iff split:if_split_asm)
from ‹valid_edge a› ‹intra_kind (kind a)› ‹distance (targetnode a) mex x›
have ex1:"∃!a'. sourcenode a = sourcenode a' ∧ distance (targetnode a') mex x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') mex x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = n')"
by(rule only_one_SOME_edge)
have "targetnode a' ≠ (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') mex x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = n')"
proof(rule ccontr)
assume "¬ targetnode a' ≠ (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') mex x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = n')"
hence "targetnode a' = (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') mex x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = n')"
by simp
with ex1 target ‹sourcenode a = sourcenode a'› ‹valid_edge a› ‹valid_edge a'›
‹intra_kind(kind a)› ‹intra_kind(kind a')› ‹distance (targetnode a) mex x›
have "a = a'" by fastforce
with ‹targetnode a ≠ targetnode a'› show False by simp
qed
with ‹sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙› True ‹kind a' = (Q')⇩√›
‹sourcenode a = sourcenode a'› mex dist
show ?thesis by(auto dest:distance_det
simp:slice_kind_def Let_def fun_eq_iff split:if_split_asm)
next
case False
hence "obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙ ≠ {}" .
then obtain m where "m ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙" by auto
hence "m = (THE m. m ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙)"
by(auto dest:obs_intra_the_element)
with ‹sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙›
‹obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙ ≠ {}›
‹slice_kind S a = (λs. True)⇩√› ‹kind a = (Q)⇩√›
obtain x x' where "distance (targetnode a) m x"
"distance (sourcenode a) m (x + 1)"
and target:"targetnode a = (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') m x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = n')"
by(auto simp:slice_kind_def Let_def fun_eq_iff split:if_split_asm)
show ?thesis
proof(cases "distance (targetnode a') m x")
case False
with ‹sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙› ‹kind a' = (Q')⇩√›
‹m ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙›
‹distance (targetnode a) m x› ‹distance (sourcenode a) m (x + 1)›
‹sourcenode a = sourcenode a'› show ?thesis
by(fastforce intro:slice_kind_Pred_obs_not_nearer)
next
case True
from ‹valid_edge a› ‹intra_kind(kind a)› ‹distance (targetnode a) m x›
‹distance (sourcenode a) m (x + 1)›
have ex1:"∃!a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') m x ∧ valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = (SOME nx. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') m x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = nx)"
by -(rule only_one_SOME_dist_edge)
have "targetnode a' ≠ (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') m x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = n')"
proof(rule ccontr)
assume "¬ targetnode a' ≠ (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') m x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = n')"
hence "targetnode a' = (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') m x ∧
valid_edge a' ∧ intra_kind(kind a') ∧
targetnode a' = n')"
by simp
with ex1 target ‹sourcenode a = sourcenode a'›
‹valid_edge a› ‹valid_edge a'› ‹intra_kind(kind a)› ‹intra_kind(kind a')›
‹distance (targetnode a) m x› ‹distance (sourcenode a) m (x + 1)›
have "a = a'" by auto
with ‹targetnode a ≠ targetnode a'› show False by simp
qed
with ‹sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙›
‹kind a' = (Q')⇩√› ‹m ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙›
‹distance (targetnode a) m x› ‹distance (sourcenode a) m (x + 1)›
True ‹sourcenode a = sourcenode a'› show ?thesis
by(fastforce intro:slice_kind_Pred_obs_nearer_not_SOME)
qed
qed
qed
qed
lemma slice_deterministic:
assumes "valid_edge a" and "valid_edge a'"
and "intra_kind (kind a)" and "intra_kind (kind a')"
and "sourcenode a = sourcenode a'" and "targetnode a ≠ targetnode a'"
obtains Q Q' where "slice_kind S a = (Q)⇩√" and "slice_kind S a' = (Q')⇩√"
and "∀s. (Q s ⟶ ¬ Q' s) ∧ (Q' s ⟶ ¬ Q s)"
proof(atomize_elim)
from assms obtain Q Q'
where "kind a = (Q)⇩√" and "kind a' = (Q')⇩√"
and det:"∀s. (Q s ⟶ ¬ Q' s) ∧ (Q' s ⟶ ¬ Q s)"
by(auto dest:deterministic)
show "∃Q Q'. slice_kind S a = (Q)⇩√ ∧ slice_kind S a' = (Q')⇩√ ∧
(∀s. (Q s ⟶ ¬ Q' s) ∧ (Q' s ⟶ ¬ Q s))"
proof(cases "sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙")
case True
with ‹kind a = (Q)⇩√› have "slice_kind S a = (Q)⇩√"
by(simp add:slice_kind_def Let_def)
from True ‹kind a' = (Q')⇩√› ‹sourcenode a = sourcenode a'›
have "slice_kind S a' = (Q')⇩√"
by(simp add:slice_kind_def Let_def)
with ‹slice_kind S a = (Q)⇩√› det show ?thesis by blast
next
case False
with ‹kind a = (Q)⇩√›
have "slice_kind S a = (λs. True)⇩√ ∨ slice_kind S a = (λs. False)⇩√"
by(simp add:slice_kind_def Let_def)
thus ?thesis
proof
assume true:"slice_kind S a = (λs. True)⇩√"
with ‹sourcenode a = sourcenode a'› ‹targetnode a ≠ targetnode a'›
‹valid_edge a› ‹valid_edge a'› ‹intra_kind (kind a)› ‹intra_kind (kind a')›
have "slice_kind S a' = (λs. False)⇩√"
by(rule slice_kind_only_one_True_edge)
with true show ?thesis by simp
next
assume false:"slice_kind S a = (λs. False)⇩√"
from False ‹kind a' = (Q')⇩√› ‹sourcenode a = sourcenode a'›
have "slice_kind S a' = (λs. True)⇩√ ∨ slice_kind S a' = (λs. False)⇩√"
by(simp add:slice_kind_def Let_def)
with false show ?thesis by auto
qed
qed
qed
end
end
Theory WeakSimulation
section ‹The weak simulation›
theory WeakSimulation imports Slice begin
context SDG begin
lemma call_node_notin_slice_return_node_neither:
assumes "call_of_return_node n n'" and "n' ∉ ⌊HRB_slice S⌋⇘CFG⇙"
shows "n ∉ ⌊HRB_slice S⌋⇘CFG⇙"
proof -
from ‹call_of_return_node n n'› obtain a a' where "return_node n"
and "valid_edge a" and "n' = sourcenode a"
and "valid_edge a'" and "a' ∈ get_return_edges a"
and "n = targetnode a'" by(fastforce simp:call_of_return_node_def)
from ‹valid_edge a› ‹a' ∈ get_return_edges a› obtain Q p r fs
where "kind a = Q:r↪⇘p⇙fs" by(fastforce dest!:only_call_get_return_edges)
with ‹valid_edge a› ‹a' ∈ get_return_edges a› obtain Q' f' where "kind a' = Q'↩⇘p⇙f'"
by(fastforce dest!:call_return_edges)
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹a' ∈ get_return_edges a›
have "CFG_node (sourcenode a) s-p→⇘sum⇙ CFG_node (targetnode a')"
by(fastforce intro:sum_SDG_call_summary_edge)
show ?thesis
proof
assume "n ∈ ⌊HRB_slice S⌋⇘CFG⇙"
with ‹n = targetnode a'› have "CFG_node (targetnode a') ∈ HRB_slice S"
by(simp add:SDG_to_CFG_set_def)
hence "CFG_node (sourcenode a) ∈ HRB_slice S"
proof(induct "CFG_node (targetnode a')" rule:HRB_slice_cases)
case (phase1 nx)
with ‹CFG_node (sourcenode a) s-p→⇘sum⇙ CFG_node (targetnode a')›
show ?case by(fastforce intro:combine_SDG_slices.combSlice_refl sum_slice1
simp:HRB_slice_def)
next
case (phase2 nx n' n'' p')
from ‹CFG_node (targetnode a') ∈ sum_SDG_slice2 n'›
‹CFG_node (sourcenode a) s-p→⇘sum⇙ CFG_node (targetnode a')› ‹valid_edge a›
have "CFG_node (sourcenode a) ∈ sum_SDG_slice2 n'"
by(fastforce intro:sum_slice2)
with ‹n' ∈ sum_SDG_slice1 nx› ‹n'' s-p'→⇘ret⇙ CFG_node (parent_node n')› ‹nx ∈ S›
show ?case by(fastforce intro:combine_SDG_slices.combSlice_Return_parent_node
simp:HRB_slice_def)
qed
with ‹n' ∉ ⌊HRB_slice S⌋⇘CFG⇙› ‹n' = sourcenode a› show False
by(simp add:SDG_to_CFG_set_def HRB_slice_def)
qed
qed
lemma edge_obs_intra_slice_eq:
assumes "valid_edge a" and "intra_kind (kind a)" and "sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙"
shows "obs_intra (targetnode a) ⌊HRB_slice S⌋⇘CFG⇙ =
obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙"
proof -
from assms have "obs_intra (targetnode a) ⌊HRB_slice S⌋⇘CFG⇙ ⊆
obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙"
by(rule edge_obs_intra_subset)
from ‹valid_edge a› have "valid_node (sourcenode a)" by simp
{ fix x assume "x ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙"
and "obs_intra (targetnode a) ⌊HRB_slice S⌋⇘CFG⇙ = {}"
have "∃as. targetnode a -as→⇩ι* x"
proof(cases "method_exit x")
case True
from ‹valid_edge a› have "valid_node (targetnode a)" by simp
then obtain asx where "targetnode a -asx→⇩√* (_Exit_)"
by(fastforce dest:Exit_path)
then obtain as pex where "targetnode a -as→⇩ι* pex" and "method_exit pex"
by -(erule valid_Exit_path_intra_path)
hence "get_proc pex = get_proc (targetnode a)"
by -(rule intra_path_get_procs[THEN sym])
also from ‹valid_edge a› ‹intra_kind (kind a)›
have "… = get_proc (sourcenode a)"
by -(rule get_proc_intra[THEN sym])
also from ‹x ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙› True
have "… = get_proc x"
by(fastforce elim:obs_intraE intro:intra_path_get_procs)
finally have "pex = x" using ‹method_exit pex› True
by -(rule method_exit_unique)
with ‹targetnode a -as→⇩ι* pex› show ?thesis by fastforce
next
case False
with ‹x ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙›
have "x postdominates (sourcenode a)" by(rule obs_intra_postdominate)
with ‹valid_edge a› ‹intra_kind (kind a)› ‹sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙›
‹x ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙›
have "x postdominates (targetnode a)"
by(fastforce elim:postdominate_inner_path_targetnode path_edge obs_intraE
simp:intra_path_def sourcenodes_def)
thus ?thesis by(fastforce elim:postdominate_implies_inner_path)
qed
then obtain as where "targetnode a -as→⇩ι* x" by blast
from ‹x ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙›
have "x ∈ ⌊HRB_slice S⌋⇘CFG⇙" by -(erule obs_intraE)
have "∃x' ∈ ⌊HRB_slice S⌋⇘CFG⇙. ∃as'. targetnode a -as'→⇩ι* x' ∧
(∀a' ∈ set (sourcenodes as'). a' ∉ ⌊HRB_slice S⌋⇘CFG⇙)"
proof(cases "∃a' ∈ set (sourcenodes as). a' ∈ ⌊HRB_slice S⌋⇘CFG⇙")
case True
then obtain zs z zs' where "sourcenodes as = zs@z#zs'"
and "z ∈ ⌊HRB_slice S⌋⇘CFG⇙" and "∀z' ∈ set zs. z' ∉ ⌊HRB_slice S⌋⇘CFG⇙"
by(erule split_list_first_propE)
then obtain ys y ys'
where "sourcenodes ys = zs" and "as = ys@y#ys'"
and "sourcenode y = z"
by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
from ‹targetnode a -as→⇩ι* x› ‹as = ys@y#ys'›
have "targetnode a -ys@y#ys'→* x" and "∀y' ∈ set ys. intra_kind (kind y')"
by(simp_all add:intra_path_def)
from ‹targetnode a -ys@y#ys'→* x› have "targetnode a -ys→* sourcenode y"
by(rule path_split)
with ‹∀y' ∈ set ys. intra_kind (kind y')› ‹sourcenode y = z›
‹∀z' ∈ set zs. z' ∉ ⌊HRB_slice S⌋⇘CFG⇙› ‹z ∈ ⌊HRB_slice S⌋⇘CFG⇙›
‹sourcenodes ys = zs›
show ?thesis by(fastforce simp:intra_path_def)
next
case False
with ‹targetnode a -as→⇩ι* x› ‹x ∈ ⌊HRB_slice S⌋⇘CFG⇙›
show ?thesis by fastforce
qed
hence "∃y. y ∈ obs_intra (targetnode a) ⌊HRB_slice S⌋⇘CFG⇙"
by(fastforce intro:obs_intra_elem)
with ‹obs_intra (targetnode a) ⌊HRB_slice S⌋⇘CFG⇙ = {}›
have False by simp }
with ‹obs_intra (targetnode a) ⌊HRB_slice S⌋⇘CFG⇙ ⊆
obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙› ‹valid_node (sourcenode a)›
show ?thesis by(cases "obs_intra (targetnode a) ⌊HRB_slice S⌋⇘CFG⇙ = {}")
(auto dest!:obs_intra_singleton_disj)
qed
lemma intra_edge_obs_slice:
assumes "ms ≠ []" and "ms'' ∈ obs ms' ⌊HRB_slice S⌋⇘CFG⇙" and "valid_edge a"
and "intra_kind (kind a)"
and disj:"(∃m ∈ set (tl ms). ∃m'. call_of_return_node m m' ∧
m' ∉ ⌊HRB_slice S⌋⇘CFG⇙) ∨ hd ms ∉ ⌊HRB_slice S⌋⇘CFG⇙"
and "hd ms = sourcenode a" and "ms' = targetnode a#tl ms"
and "∀n ∈ set (tl ms'). return_node n"
shows "ms'' ∈ obs ms ⌊HRB_slice S⌋⇘CFG⇙"
proof -
from ‹ms'' ∈ obs ms' ⌊HRB_slice S⌋⇘CFG⇙› ‹∀n ∈ set (tl ms'). return_node n›
obtain msx m msx' mx m' where "ms' = msx@m#msx'" and "ms'' = mx#msx'"
and "mx ∈ obs_intra m ⌊HRB_slice S⌋⇘CFG⇙"
and "∀nx ∈ set msx'. ∃nx'. call_of_return_node nx nx' ∧ nx' ∈ ⌊HRB_slice S⌋⇘CFG⇙"
and imp:"∀xs x xs'. msx = xs@x#xs' ∧ obs_intra x ⌊HRB_slice S⌋⇘CFG⇙ ≠ {}
⟶ (∃x'' ∈ set (xs'@[m]). ∃mx. call_of_return_node x'' mx ∧
mx ∉ ⌊HRB_slice S⌋⇘CFG⇙)"
by(erule obsE)
show ?thesis
proof(cases msx)
case Nil
with ‹∀nx ∈ set msx'. ∃nx'. call_of_return_node nx nx' ∧ nx' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
disj ‹ms' = msx@m#msx'› ‹hd ms = sourcenode a› ‹ms' = targetnode a#tl ms›
have "sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙" by(cases ms) auto
from ‹ms' = msx@m#msx'› ‹ms' = targetnode a#tl ms› Nil
have "m = targetnode a" by simp
with ‹valid_edge a› ‹intra_kind (kind a)› ‹sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙›
‹mx ∈ obs_intra m ⌊HRB_slice S⌋⇘CFG⇙›
have "mx ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙"
by(fastforce dest:edge_obs_intra_subset)
from ‹ms' = msx@m#msx'› Nil ‹ms' = targetnode a # tl ms›
‹hd ms = sourcenode a› ‹ms ≠ []›
have "ms = []@sourcenode a#msx'" by(cases ms) auto
with ‹ms'' = mx#msx'› ‹mx ∈ obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙›
‹∀nx ∈ set msx'. ∃nx'. call_of_return_node nx nx' ∧ nx' ∈ ⌊HRB_slice S⌋⇘CFG⇙› Nil
show ?thesis by(fastforce intro!:obsI)
next
case (Cons x xs)
with ‹ms' = msx@m#msx'› ‹ms' = targetnode a # tl ms›
have "msx = targetnode a#xs" by simp
from Cons ‹ms' = msx@m#msx'› ‹ms' = targetnode a # tl ms› ‹hd ms = sourcenode a›
have "ms = (sourcenode a#xs)@m#msx'" by(cases ms) auto
from disj ‹ms = (sourcenode a#xs)@m#msx'›
‹∀nx ∈ set msx'. ∃nx'. call_of_return_node nx nx' ∧ nx' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
have disj2:"(∃m ∈ set (xs@[m]). ∃m'. call_of_return_node m m' ∧
m' ∉ ⌊HRB_slice S⌋⇘CFG⇙) ∨ hd ms ∉ ⌊HRB_slice S⌋⇘CFG⇙"
by fastforce
hence "∀zs z zs'. sourcenode a#xs = zs@z#zs' ∧ obs_intra z ⌊HRB_slice S⌋⇘CFG⇙ ≠ {}
⟶ (∃z'' ∈ set (zs'@[m]). ∃mx. call_of_return_node z'' mx ∧
mx ∉ ⌊HRB_slice S⌋⇘CFG⇙)"
proof(cases "hd ms ∉ ⌊HRB_slice S⌋⇘CFG⇙")
case True
with ‹hd ms = sourcenode a› have "sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙" by simp
with ‹valid_edge a› ‹intra_kind (kind a)›
have "obs_intra (targetnode a) ⌊HRB_slice S⌋⇘CFG⇙ =
obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙"
by(rule edge_obs_intra_slice_eq)
with imp ‹msx = targetnode a#xs› show ?thesis
by auto(case_tac zs,fastforce,erule_tac x="targetnode a#list" in allE,fastforce)
next
case False
with ‹hd ms = sourcenode a› ‹valid_edge a›
have "obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙ = {sourcenode a}"
by(fastforce intro!:n_in_obs_intra)
from False disj2
have "∃m ∈ set (xs@[m]). ∃m'. call_of_return_node m m' ∧ m' ∉ ⌊HRB_slice S⌋⇘CFG⇙"
by simp
with imp ‹obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙ = {sourcenode a}›
‹msx = targetnode a#xs› show ?thesis
by auto(case_tac zs,fastforce,erule_tac x="targetnode a#list" in allE,fastforce)
qed
with ‹ms' = msx@m#msx'› ‹ms' = targetnode a # tl ms› ‹hd ms = sourcenode a›
‹ms'' = mx#msx'› ‹mx ∈ obs_intra m ⌊HRB_slice S⌋⇘CFG⇙›
‹∀nx ∈ set msx'. ∃nx'. call_of_return_node nx nx' ∧ nx' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
‹ms = (sourcenode a#xs)@m#msx'›
show ?thesis by(simp del:obs.simps)(rule obsI,auto)
qed
qed
subsection ‹Silent moves›
inductive silent_move ::
"'node SDG_node set ⇒ ('edge ⇒ ('var,'val,'ret,'pname) edge_kind) ⇒ 'node list ⇒
(('var ⇀ 'val) × 'ret) list ⇒ 'edge ⇒ 'node list ⇒ (('var ⇀ 'val) × 'ret) list ⇒ bool"
("_,_ ⊢ '(_,_') -_→⇩τ '(_,_')" [51,50,0,0,50,0,0] 51)
where silent_move_intra:
"⟦pred (f a) s; transfer (f a) s = s'; valid_edge a; intra_kind(kind a);
(∃m ∈ set (tl ms). ∃m'. call_of_return_node m m' ∧ m' ∉ ⌊HRB_slice S⌋⇘CFG⇙) ∨
hd ms ∉ ⌊HRB_slice S⌋⇘CFG⇙; ∀m ∈ set (tl ms). return_node m;
length s' = length s; length ms = length s;
hd ms = sourcenode a; ms' = (targetnode a)#tl ms⟧
⟹ S,f ⊢ (ms,s) -a→⇩τ (ms',s')"
| silent_move_call:
"⟦pred (f a) s; transfer (f a) s = s'; valid_edge a; kind a = Q:r↪⇘p⇙fs;
valid_edge a'; a' ∈ get_return_edges a;
(∃m ∈ set (tl ms). ∃m'. call_of_return_node m m' ∧ m' ∉ ⌊HRB_slice S⌋⇘CFG⇙) ∨
hd ms ∉ ⌊HRB_slice S⌋⇘CFG⇙; ∀m ∈ set (tl ms). return_node m;
length ms = length s; length s' = Suc(length s);
hd ms = sourcenode a; ms' = (targetnode a)#(targetnode a')#tl ms⟧
⟹ S,f ⊢ (ms,s) -a→⇩τ (ms',s')"
| silent_move_return:
"⟦pred (f a) s; transfer (f a) s = s'; valid_edge a; kind a = Q↩⇘p⇙f';
∃m ∈ set (tl ms). ∃m'. call_of_return_node m m' ∧ m' ∉ ⌊HRB_slice S⌋⇘CFG⇙;
∀m ∈ set (tl ms). return_node m; length ms = length s; length s = Suc(length s');
s' ≠ []; hd ms = sourcenode a; hd(tl ms) = targetnode a; ms' = tl ms⟧
⟹ S,f ⊢ (ms,s) -a→⇩τ (ms',s')"
lemma silent_move_valid_nodes:
"⟦S,f ⊢ (ms,s) -a→⇩τ (ms',s'); ∀m ∈ set ms'. valid_node m⟧
⟹ ∀m ∈ set ms. valid_node m"
by(induct rule:silent_move.induct)(case_tac ms,auto)+
lemma silent_move_return_node:
"S,f ⊢ (ms,s) -a→⇩τ (ms',s') ⟹ ∀m ∈ set (tl ms'). return_node m"
proof(induct rule:silent_move.induct)
case (silent_move_intra f a s s' ms n⇩c ms')
thus ?case by simp
next
case (silent_move_call f a s s' Q r p fs a' ms n⇩c ms')
from ‹valid_edge a'› ‹valid_edge a› ‹a' ∈ get_return_edges a›
have "return_node (targetnode a')" by(fastforce simp:return_node_def)
with ‹∀m∈set (tl ms). return_node m› ‹ms' = targetnode a # targetnode a' # tl ms›
show ?case by simp
next
case (silent_move_return f a s s' Q p f' ms n⇩c ms')
thus ?case by(cases "tl ms") auto
qed
lemma silent_move_equal_length:
assumes "S,f ⊢ (ms,s) -a→⇩τ (ms',s')"
shows "length ms = length s" and "length ms' = length s'"
proof -
from ‹S,f ⊢ (ms,s) -a→⇩τ (ms',s')›
have "length ms = length s ∧ length ms' = length s'"
proof(induct rule:silent_move.induct)
case (silent_move_intra f a s s' ms n⇩c ms')
from ‹pred (f a) s› obtain cf cfs where [simp]:"s = cf#cfs" by(cases s) auto
from ‹length ms = length s› ‹ms' = targetnode a # tl ms›
‹length s' = length s› show ?case by simp
next
case (silent_move_call f a s s' Q r p fs a' ms n⇩c ms')
from ‹pred (f a) s› obtain cf cfs where [simp]:"s = cf#cfs" by(cases s) auto
from ‹length ms = length s› ‹length s' = Suc (length s)›
‹ms' = targetnode a # targetnode a' # tl ms› show ?case by simp
next
case (silent_move_return f a s s' Q p f' ms n⇩c ms')
from ‹length ms = length s› ‹length s = Suc (length s')› ‹ms' = tl ms› ‹s' ≠ []›
show ?case by simp
qed
thus "length ms = length s" and "length ms' = length s'" by simp_all
qed
lemma silent_move_obs_slice:
"⟦S,kind ⊢ (ms,s) -a→⇩τ (ms',s'); msx ∈ obs ms' ⌊HRB_slice S⌋⇘CFG⇙;
∀n ∈ set (tl ms'). return_node n⟧
⟹ msx ∈ obs ms ⌊HRB_slice S⌋⇘CFG⇙"
proof(induct S f≡"kind" ms s a ms' s' rule:silent_move.induct)
case (silent_move_intra a s s' ms n⇩c ms')
from ‹pred (kind a) s› ‹length ms = length s› have "ms ≠ []"
by(cases s) auto
with silent_move_intra show ?case by -(rule intra_edge_obs_slice)
next
case (silent_move_call a s s' Q r p fs a' ms S ms')
note disj = ‹(∃m∈set (tl ms). ∃m'. call_of_return_node m m' ∧
m' ∉ ⌊HRB_slice S⌋⇘CFG⇙) ∨ hd ms ∉ ⌊HRB_slice S⌋⇘CFG⇙›
from ‹valid_edge a'› ‹valid_edge a› ‹a' ∈ get_return_edges a›
have "return_node (targetnode a')" by(fastforce simp:return_node_def)
with ‹valid_edge a› ‹a' ∈ get_return_edges a› ‹valid_edge a'›
have "call_of_return_node (targetnode a') (sourcenode a)"
by(simp add:call_of_return_node_def) blast
from ‹pred (kind a) s› ‹length ms = length s›
have "ms ≠ []" by(cases s) auto
from disj
show ?case
proof
assume "hd ms ∉ ⌊HRB_slice S⌋⇘CFG⇙"
with ‹hd ms = sourcenode a› have "sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙" by simp
with ‹call_of_return_node (targetnode a') (sourcenode a)›
‹ms' = targetnode a # targetnode a' # tl ms›
have "∃n' ∈ set (tl ms'). ∃nx. call_of_return_node n' nx ∧ nx ∉ ⌊HRB_slice S⌋⇘CFG⇙"
by fastforce
with ‹msx ∈ obs ms' ⌊HRB_slice S⌋⇘CFG⇙› ‹ms' = targetnode a # targetnode a' # tl ms›
have "msx ∈ obs (targetnode a' # tl ms) ⌊HRB_slice S⌋⇘CFG⇙" by simp
from ‹valid_edge a› ‹a' ∈ get_return_edges a›
obtain a'' where "valid_edge a''" and [simp]:"sourcenode a'' = sourcenode a"
and [simp]:"targetnode a'' = targetnode a'" and "intra_kind(kind a'')"
by -(drule call_return_node_edge,auto simp:intra_kind_def)
from ‹∀m∈set (tl ms'). return_node m› ‹ms' = targetnode a # targetnode a' # tl ms›
have "∀m∈set (tl ms). return_node m" by simp
with ‹ms ≠ []› ‹msx ∈ obs (targetnode a'#tl ms) ⌊HRB_slice S⌋⇘CFG⇙›
‹valid_edge a''› ‹intra_kind(kind a'')› disj
‹hd ms = sourcenode a›
show ?case by -(rule intra_edge_obs_slice,fastforce+)
next
assume "∃m∈set (tl ms).
∃m'. call_of_return_node m m' ∧ m' ∉ ⌊HRB_slice S⌋⇘CFG⇙"
with ‹ms ≠ []› ‹msx ∈ obs ms' ⌊HRB_slice S⌋⇘CFG⇙›
‹ms' = targetnode a # targetnode a' # tl ms›
show ?thesis by(cases ms) auto
qed
next
case (silent_move_return a s s' Q p f' ms S ms')
from ‹length ms = length s› ‹length s = Suc (length s')› ‹s' ≠ []›
have "ms ≠ []" and "tl ms ≠ []" by(auto simp:length_Suc_conv)
from ‹∃m∈set (tl ms).
∃m'. call_of_return_node m m' ∧ m' ∉ ⌊HRB_slice S⌋⇘CFG⇙›
‹tl ms ≠ []› ‹hd (tl ms) = targetnode a›
have "(∃m'. call_of_return_node (targetnode a) m' ∧ m' ∉ ⌊HRB_slice S⌋⇘CFG⇙) ∨
(∃m∈set (tl (tl ms)). ∃m'. call_of_return_node m m' ∧ m' ∉ ⌊HRB_slice S⌋⇘CFG⇙)"
by(cases "tl ms") auto
hence "obs ms ⌊HRB_slice S⌋⇘CFG⇙ = obs (tl ms) ⌊HRB_slice S⌋⇘CFG⇙"
proof
assume "∃m'. call_of_return_node (targetnode a) m' ∧ m' ∉ ⌊HRB_slice S⌋⇘CFG⇙"
from ‹tl ms ≠ []› have "hd (tl ms) ∈ set (tl ms)" by simp
with ‹hd (tl ms) = targetnode a› have "targetnode a ∈ set (tl ms)" by simp
with ‹ms ≠ []›
‹∃m'. call_of_return_node (targetnode a) m' ∧ m' ∉ ⌊HRB_slice S⌋⇘CFG⇙›
have "∃m∈set (tl ms). ∃m'. call_of_return_node m m' ∧
m' ∉ ⌊HRB_slice S⌋⇘CFG⇙" by(cases ms) auto
with ‹ms ≠ []› show ?thesis by(cases ms) auto
next
assume "∃m∈set (tl (tl ms)). ∃m'. call_of_return_node m m' ∧
m' ∉ ⌊HRB_slice S⌋⇘CFG⇙"
with ‹ms ≠ []› ‹tl ms ≠ []› show ?thesis
by(cases ms,auto simp:Let_def)(case_tac list,auto)+
qed
with ‹ms' = tl ms› ‹msx ∈ obs ms' ⌊HRB_slice S⌋⇘CFG⇙› show ?case by simp
qed
lemma silent_move_empty_obs_slice:
assumes "S,f ⊢ (ms,s) -a→⇩τ (ms',s')" and "obs ms' ⌊HRB_slice S⌋⇘CFG⇙ = {}"
shows "obs ms ⌊HRB_slice S⌋⇘CFG⇙ = {}"
proof(rule ccontr)
assume "obs ms ⌊HRB_slice S⌋⇘CFG⇙ ≠ {}"
then obtain xs where "xs ∈ obs ms ⌊HRB_slice S⌋⇘CFG⇙" by fastforce
from ‹S,f ⊢ (ms,s) -a→⇩τ (ms',s')›
have "∀m ∈ set (tl ms). return_node m"
by(fastforce elim!:silent_move.cases simp:call_of_return_node_def)
with ‹xs ∈ obs ms ⌊HRB_slice S⌋⇘CFG⇙›
obtain msx m msx' m' where assms:"ms = msx@m#msx'" "xs = m'#msx'"
"m' ∈ obs_intra m ⌊HRB_slice S⌋⇘CFG⇙"
"∀mx ∈ set msx'. ∃mx'. call_of_return_node mx mx' ∧ mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙"
"∀xs x xs'. msx = xs@x#xs' ∧ obs_intra x ⌊HRB_slice S⌋⇘CFG⇙ ≠ {}
⟶ (∃x'' ∈ set (xs'@[m]). ∃mx. call_of_return_node x'' mx ∧
mx ∉ ⌊HRB_slice S⌋⇘CFG⇙)"
by(erule obsE)
from ‹S,f ⊢ (ms,s) -a→⇩τ (ms',s')› ‹obs ms' ⌊HRB_slice S⌋⇘CFG⇙ = {}› assms
show False
proof(induct rule:silent_move.induct)
case (silent_move_intra f a s s' ms S ms')
note disj = ‹(∃m∈set (tl ms). ∃m'. call_of_return_node m m' ∧
m' ∉ ⌊HRB_slice S⌋⇘CFG⇙) ∨ hd ms ∉ ⌊HRB_slice S⌋⇘CFG⇙›
note msx = ‹∀xs x xs'. msx = xs@x#xs' ∧ obs_intra x ⌊HRB_slice S⌋⇘CFG⇙ ≠ {} ⟶
(∃x''∈set (xs' @ [m]). ∃mx. call_of_return_node x'' mx ∧ mx ∉ ⌊HRB_slice S⌋⇘CFG⇙)›
note msx' = ‹∀mx∈set msx'. ∃mx'. call_of_return_node mx mx' ∧
mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
show False
proof(cases msx)
case Nil
with ‹ms = msx @ m # msx'› ‹hd ms = sourcenode a› have [simp]:"m = sourcenode a"
and "tl ms = msx'" by simp_all
from Nil ‹ms' = targetnode a # tl ms› ‹ms = msx @ m # msx'›
have "ms' = msx @ targetnode a # msx'" by simp
from msx' disj ‹tl ms = msx'› ‹hd ms = sourcenode a›
have "sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙" by fastforce
with ‹valid_edge a› ‹intra_kind (kind a)›
have "obs_intra (targetnode a) ⌊HRB_slice S⌋⇘CFG⇙ =
obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙" by(rule edge_obs_intra_slice_eq)
with ‹m' ∈ obs_intra m ⌊HRB_slice S⌋⇘CFG⇙›
have "m' ∈ obs_intra (targetnode a) ⌊HRB_slice S⌋⇘CFG⇙" by simp
from msx Nil have "∀xs x xs'. msx = xs@x#xs' ∧
obs_intra x ⌊HRB_slice S⌋⇘CFG⇙ ≠ {} ⟶
(∃x''∈set (xs' @ [targetnode a]). ∃mx. call_of_return_node x'' mx ∧
mx ∉ ⌊HRB_slice S⌋⇘CFG⇙)" by simp
with ‹m' ∈ obs_intra (targetnode a) ⌊HRB_slice S⌋⇘CFG⇙› msx'
‹ms' = msx @ targetnode a # msx'›
have "m'#msx' ∈ obs ms' ⌊HRB_slice S⌋⇘CFG⇙" by(rule obsI)
with ‹obs ms' ⌊HRB_slice S⌋⇘CFG⇙ = {}› show False by simp
next
case (Cons y ys)
with ‹ms = msx @ m # msx'› ‹ms' = targetnode a # tl ms› ‹hd ms = sourcenode a›
have "ms' = targetnode a # ys @ m # msx'" and "y = sourcenode a"
and "tl ms = ys @ m # msx'" by simp_all
{ fix x assume "x ∈ obs_intra (targetnode a) ⌊HRB_slice S⌋⇘CFG⇙"
have "obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙ ≠ {}"
proof(cases "sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙")
case True
from ‹valid_edge a› have "valid_node (sourcenode a)" by simp
from this True
have "obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙ = {sourcenode a}"
by(rule n_in_obs_intra)
thus ?thesis by simp
next
case False
from ‹valid_edge a› ‹intra_kind (kind a)› False
have "obs_intra (targetnode a) ⌊HRB_slice S⌋⇘CFG⇙ =
obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙"
by(rule edge_obs_intra_slice_eq)
with ‹x ∈ obs_intra (targetnode a) ⌊HRB_slice S⌋⇘CFG⇙› show ?thesis
by fastforce
qed }
with msx Cons ‹y = sourcenode a›
have "∀xs x xs'. targetnode a # ys = xs@x#xs' ∧
obs_intra x ⌊HRB_slice S⌋⇘CFG⇙ ≠ {} ⟶ (∃x''∈set (xs' @ [m]).
∃mx. call_of_return_node x'' mx ∧ mx ∉ ⌊HRB_slice S⌋⇘CFG⇙)"
apply clarsimp apply(case_tac xs) apply auto
apply(erule_tac x="[]" in allE) apply clarsimp
apply(erule_tac x="sourcenode a # list" in allE) apply auto
done
with ‹m' ∈ obs_intra m ⌊HRB_slice S⌋⇘CFG⇙› msx'
‹ms' = targetnode a # ys @ m # msx'›
have "m'#msx' ∈ obs ms' ⌊HRB_slice S⌋⇘CFG⇙" by -(rule obsI,auto)
with ‹obs ms' ⌊HRB_slice S⌋⇘CFG⇙ = {}› show False by simp
qed
next
case (silent_move_call f a s s' Q r p fs a' ms S ms')
note disj = ‹(∃m∈set (tl ms). ∃m'. call_of_return_node m m' ∧
m' ∉ ⌊HRB_slice S⌋⇘CFG⇙) ∨ hd ms ∉ ⌊HRB_slice S⌋⇘CFG⇙›
note msx = ‹∀xs x xs'. msx = xs@x#xs' ∧ obs_intra x ⌊HRB_slice S⌋⇘CFG⇙ ≠ {} ⟶
(∃x''∈set (xs' @ [m]). ∃mx. call_of_return_node x'' mx ∧ mx ∉ ⌊HRB_slice S⌋⇘CFG⇙)›
note msx' = ‹∀mx∈set msx'. ∃mx'. call_of_return_node mx mx' ∧
mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
from ‹valid_edge a› ‹a' ∈ get_return_edges a› obtain a'' where "valid_edge a''"
and "sourcenode a'' = sourcenode a" and "targetnode a'' = targetnode a'"
and "intra_kind (kind a'')"
by(fastforce dest:call_return_node_edge simp:intra_kind_def)
from ‹valid_edge a'› ‹valid_edge a› ‹a' ∈ get_return_edges a›
have "call_of_return_node (targetnode a') (sourcenode a)"
by(fastforce simp:call_of_return_node_def return_node_def)
show False
proof(cases msx)
case Nil
with ‹ms = msx @ m # msx'› ‹hd ms = sourcenode a› have [simp]:"m = sourcenode a"
and "tl ms = msx'" by simp_all
from Nil ‹ms' = targetnode a # targetnode a' # tl ms› ‹ms = msx @ m # msx'›
have "ms' = targetnode a # targetnode a' # msx'" by simp
from msx' disj ‹tl ms = msx'› ‹hd ms = sourcenode a›
have "sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙" by fastforce
from ‹valid_edge a''› ‹intra_kind (kind a'')› ‹sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙›
‹sourcenode a'' = sourcenode a› ‹targetnode a'' = targetnode a'›
have "obs_intra (targetnode a') ⌊HRB_slice S⌋⇘CFG⇙ =
obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙"
by(fastforce dest:edge_obs_intra_slice_eq)
with ‹m' ∈ obs_intra m ⌊HRB_slice S⌋⇘CFG⇙›
have "m' ∈ obs_intra (targetnode a') ⌊HRB_slice S⌋⇘CFG⇙" by simp
from this msx' have "m'#msx' ∈ obs (targetnode a'#msx') ⌊HRB_slice S⌋⇘CFG⇙"
by(fastforce intro:obsI)
from ‹call_of_return_node (targetnode a') (sourcenode a)›
‹sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙›
have "∃m' ∈ set (targetnode a'#msx').
∃mx. call_of_return_node m' mx ∧ mx ∉ ⌊HRB_slice S⌋⇘CFG⇙"
by fastforce
with ‹m'#msx' ∈ obs (targetnode a'#msx') ⌊HRB_slice S⌋⇘CFG⇙›
have "m'#msx' ∈ obs (targetnode a#targetnode a'#msx') ⌊HRB_slice S⌋⇘CFG⇙"
by simp
with ‹ms' = targetnode a # targetnode a' # msx'› ‹obs ms' ⌊HRB_slice S⌋⇘CFG⇙ = {}›
show False by simp
next
case (Cons y ys)
with ‹ms = msx @ m # msx'› ‹ms' = targetnode a # targetnode a' # tl ms›
‹hd ms = sourcenode a›
have "ms' = targetnode a # targetnode a' # ys @ m # msx'"
and "y = sourcenode a" and "tl ms = ys @ m # msx'" by simp_all
show False
proof(cases "obs_intra (targetnode a) ⌊HRB_slice S⌋⇘CFG⇙ ≠ {} ⟶
(∃x''∈set (targetnode a' # ys @ [m]).
∃mx. call_of_return_node x'' mx ∧ mx ∉ ⌊HRB_slice S⌋⇘CFG⇙)")
case True
hence imp:"obs_intra (targetnode a) ⌊HRB_slice S⌋⇘CFG⇙ ≠ {} ⟶
(∃x''∈set (targetnode a' # ys @ [m]).
∃mx. call_of_return_node x'' mx ∧ mx ∉ ⌊HRB_slice S⌋⇘CFG⇙)" .
show False
proof(cases "obs_intra (targetnode a') ⌊HRB_slice S⌋⇘CFG⇙ ≠ {} ⟶
(∃x''∈set (ys @ [m]). ∃mx. call_of_return_node x'' mx ∧
mx ∉ ⌊HRB_slice S⌋⇘CFG⇙)")
case True
with imp msx Cons ‹y = sourcenode a›
have "∀xs x xs'. targetnode a # targetnode a' # ys = xs@x#xs' ∧
obs_intra x ⌊HRB_slice S⌋⇘CFG⇙ ≠ {} ⟶ (∃x''∈set (xs' @ [m]).
∃mx. call_of_return_node x'' mx ∧ mx ∉ ⌊HRB_slice S⌋⇘CFG⇙)"
apply clarsimp apply(case_tac xs) apply fastforce
apply(case_tac list) apply fastforce apply clarsimp
apply(erule_tac x="sourcenode a # lista" in allE) apply auto
done
with ‹m' ∈ obs_intra m ⌊HRB_slice S⌋⇘CFG⇙› msx'
‹ms' = targetnode a # targetnode a' # ys @ m # msx'›
have "m'#msx' ∈ obs ms' ⌊HRB_slice S⌋⇘CFG⇙" by -(rule obsI,auto)
with ‹obs ms' ⌊HRB_slice S⌋⇘CFG⇙ = {}› show False by simp
next
case False
hence "obs_intra (targetnode a') ⌊HRB_slice S⌋⇘CFG⇙ ≠ {}"
and all:"∀x''∈set (ys @ [m]). ∀mx. call_of_return_node x'' mx ⟶
mx ∈ ⌊HRB_slice S⌋⇘CFG⇙"
by fastforce+
have "obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙ ≠ {}"
proof(cases "sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙")
case True
from ‹valid_edge a› have "valid_node (sourcenode a)" by simp
from this True
have "obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙ = {sourcenode a}"
by(rule n_in_obs_intra)
thus ?thesis by simp
next
case False
with ‹sourcenode a'' = sourcenode a›
have "sourcenode a'' ∉ ⌊HRB_slice S⌋⇘CFG⇙" by simp
with ‹valid_edge a''› ‹intra_kind (kind a'')›
have "obs_intra (targetnode a'') ⌊HRB_slice S⌋⇘CFG⇙ =
obs_intra (sourcenode a'') ⌊HRB_slice S⌋⇘CFG⇙"
by(rule edge_obs_intra_slice_eq)
with ‹obs_intra (targetnode a') ⌊HRB_slice S⌋⇘CFG⇙ ≠ {}›
‹sourcenode a'' = sourcenode a› ‹targetnode a'' = targetnode a'›
show ?thesis by fastforce
qed
with msx Cons ‹y = sourcenode a› all
show False by simp blast
qed
next
case False
hence "obs_intra (targetnode a) ⌊HRB_slice S⌋⇘CFG⇙ ≠ {}"
and all:"∀x''∈set (targetnode a' # ys @ [m]).
∀mx. call_of_return_node x'' mx ⟶ mx ∈ ⌊HRB_slice S⌋⇘CFG⇙"
by fastforce+
with Cons ‹y = sourcenode a› msx
have "obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙ = {}" by auto blast
from ‹call_of_return_node (targetnode a') (sourcenode a)› all
have "sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙" by fastforce
from ‹valid_edge a› have "valid_node (sourcenode a)" by simp
from this ‹sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙›
have "obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙ = {sourcenode a}"
by(rule n_in_obs_intra)
with ‹obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙ = {}› show False by simp
qed
qed
next
case (silent_move_return f a s s' Q p f' ms S ms')
note msx = ‹∀xs x xs'. msx = xs@x#xs' ∧ obs_intra x ⌊HRB_slice S⌋⇘CFG⇙ ≠ {} ⟶
(∃x''∈set (xs' @ [m]). ∃mx. call_of_return_node x'' mx ∧ mx ∉ ⌊HRB_slice S⌋⇘CFG⇙)›
note msx' = ‹∀mx∈set msx'. ∃mx'. call_of_return_node mx mx' ∧
mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
show False
proof(cases msx)
case Nil
with ‹ms = msx @ m # msx'› ‹hd ms = sourcenode a› have "tl ms = msx'" by simp
with ‹∃m∈set (tl ms). ∃m'. call_of_return_node m m' ∧ m' ∉ ⌊HRB_slice S⌋⇘CFG⇙›
msx'
show False by fastforce
next
case (Cons y ys)
with ‹ms = msx @ m # msx'› ‹hd ms = sourcenode a› ‹ms' = tl ms›
have "ms' = ys @ m # msx'" and "y = sourcenode a" by simp_all
from msx Cons have "∀xs x xs'. ys = xs@x#xs' ∧
obs_intra x ⌊HRB_slice S⌋⇘CFG⇙ ≠ {} ⟶ (∃x''∈set (xs' @ [m]).
∃mx. call_of_return_node x'' mx ∧ mx ∉ ⌊HRB_slice S⌋⇘CFG⇙)"
by auto (erule_tac x="y # xs" in allE,auto)
with ‹m' ∈ obs_intra m ⌊HRB_slice S⌋⇘CFG⇙› msx' ‹ms' = ys @ m # msx'›
have "m'#msx' ∈ obs ms' ⌊HRB_slice S⌋⇘CFG⇙" by(rule obsI)
with ‹obs ms' ⌊HRB_slice S⌋⇘CFG⇙ = {}› show False by simp
qed
qed
qed
inductive silent_moves ::
"'node SDG_node set ⇒ ('edge ⇒ ('var,'val,'ret,'pname) edge_kind) ⇒ 'node list ⇒
(('var ⇀ 'val) × 'ret) list ⇒ 'edge list ⇒ 'node list ⇒ (('var ⇀ 'val) × 'ret) list ⇒ bool"
("_,_ ⊢ '(_,_') =_⇒⇩τ '(_,_')" [51,50,0,0,50,0,0] 51)
where silent_moves_Nil: "length ms = length s ⟹ S,f ⊢ (ms,s) =[]⇒⇩τ (ms,s)"
| silent_moves_Cons:
"⟦S,f ⊢ (ms,s) -a→⇩τ (ms',s'); S,f ⊢ (ms',s') =as⇒⇩τ (ms'',s'')⟧
⟹ S,f ⊢ (ms,s) =a#as⇒⇩τ (ms'',s'')"
lemma silent_moves_equal_length:
assumes "S,f ⊢ (ms,s) =as⇒⇩τ (ms',s')"
shows "length ms = length s" and "length ms' = length s'"
proof -
from ‹S,f ⊢ (ms,s) =as⇒⇩τ (ms',s')›
have "length ms = length s ∧ length ms' = length s'"
proof(induct rule:silent_moves.induct)
case (silent_moves_Cons S f ms s a ms' s' as ms'' s'')
from ‹S,f ⊢ (ms,s) -a→⇩τ (ms',s')›
have "length ms = length s" and "length ms' = length s'"
by(rule silent_move_equal_length)+
with ‹length ms' = length s' ∧ length ms'' = length s''›
show ?case by simp
qed simp
thus "length ms = length s" "length ms' = length s'" by simp_all
qed
lemma silent_moves_Append:
"⟦S,f ⊢ (ms,s) =as⇒⇩τ (ms'',s''); S,f ⊢ (ms'',s'') =as'⇒⇩τ (ms',s')⟧
⟹ S,f ⊢ (ms,s) =as@as'⇒⇩τ (ms',s')"
by(induct rule:silent_moves.induct)(auto intro:silent_moves.intros)
lemma silent_moves_split:
assumes "S,f ⊢ (ms,s) =as@as'⇒⇩τ (ms',s')"
obtains ms'' s'' where "S,f ⊢ (ms,s) =as⇒⇩τ (ms'',s'')"
and "S,f ⊢ (ms'',s'') =as'⇒⇩τ (ms',s')"
proof(atomize_elim)
from ‹S,f ⊢ (ms,s) =as@as'⇒⇩τ (ms',s')›
show "∃ms'' s''. S,f ⊢ (ms,s) =as⇒⇩τ (ms'',s'') ∧ S,f ⊢ (ms'',s'') =as'⇒⇩τ (ms',s')"
proof(induct as arbitrary:ms s)
case Nil
from ‹S,f ⊢ (ms,s) =[] @ as'⇒⇩τ (ms',s')› have "length ms = length s"
by(fastforce intro:silent_moves_equal_length)
hence "S,f ⊢ (ms,s) =[]⇒⇩τ (ms,s)" by(rule silent_moves_Nil)
with ‹S,f ⊢ (ms,s) =[] @ as'⇒⇩τ (ms',s')› show ?case by fastforce
next
case (Cons ax asx)
note IH = ‹⋀ms s. S,f ⊢ (ms,s) =asx @ as'⇒⇩τ (ms',s') ⟹
∃ms'' s''. S,f ⊢ (ms,s) =asx⇒⇩τ (ms'',s'') ∧ S,f ⊢ (ms'',s'') =as'⇒⇩τ (ms',s')›
from ‹S,f ⊢ (ms,s) =(ax # asx) @ as'⇒⇩τ (ms',s')›
obtain msx sx where "S,f ⊢ (ms,s) -ax→⇩τ (msx,sx)"
and "S,f ⊢ (msx,sx) =asx @ as'⇒⇩τ (ms',s')"
by(auto elim:silent_moves.cases)
from IH[OF this(2)] obtain ms'' s'' where "S,f ⊢ (msx,sx) =asx⇒⇩τ (ms'',s'')"
and "S,f ⊢ (ms'',s'') =as'⇒⇩τ (ms',s')" by blast
from ‹S,f ⊢ (ms,s) -ax→⇩τ (msx,sx)› ‹S,f ⊢ (msx,sx) =asx⇒⇩τ (ms'',s'')›
have "S,f ⊢ (ms,s) =ax#asx⇒⇩τ (ms'',s'')" by(rule silent_moves_Cons)
with ‹S,f ⊢ (ms'',s'') =as'⇒⇩τ (ms',s')› show ?case by blast
qed
qed
lemma valid_nodes_silent_moves:
"⟦S,f⊢ (ms,s) =as'⇒⇩τ (ms',s'); ∀m ∈ set ms. valid_node m⟧
⟹ ∀m ∈ set ms'. valid_node m"
proof(induct rule:silent_moves.induct)
case (silent_moves_Cons S f ms s a ms' s' as ms'' s'')
note IH = ‹∀m∈set ms'. valid_node m ⟹ ∀m∈set ms''. valid_node m›
from ‹S,f ⊢ (ms,s) -a→⇩τ (ms',s')› ‹∀m∈set ms. valid_node m›
have "∀m∈set ms'. valid_node m"
apply - apply(erule silent_move.cases) apply auto
by(cases ms,auto dest:get_return_edges_valid)+
from IH[OF this] show ?case .
qed simp
lemma return_nodes_silent_moves:
"⟦S,f ⊢ (ms,s) =as'⇒⇩τ (ms',s'); ∀m ∈ set (tl ms). return_node m⟧
⟹ ∀m ∈ set (tl ms'). return_node m"
by(induct rule:silent_moves.induct,auto dest:silent_move_return_node)
lemma silent_moves_intra_path:
"⟦S,f ⊢ (m#ms,s) =as⇒⇩τ (m'#ms',s'); ∀a ∈ set as. intra_kind(kind a)⟧
⟹ ms = ms' ∧ get_proc m = get_proc m'"
proof(induct S f "m#ms" s as "m'#ms'" s' arbitrary:m
rule:silent_moves.induct)
case (silent_moves_Cons S f sx a msx' sx' as s'')
thus ?case
proof(induct _ _ "m # ms" _ _ _ _ rule:silent_move.induct)
case (silent_move_intra f a s s' n⇩c msx')
note IH = ‹⋀m. ⟦msx' = m # ms; ∀a∈set as. intra_kind (kind a)⟧
⟹ ms = ms' ∧ get_proc m = get_proc m'›
from ‹msx' = targetnode a # tl (m # ms)›
have "msx' = targetnode a # ms" by simp
from ‹∀a∈set (a # as). intra_kind (kind a)› have "∀a∈set as. intra_kind (kind a)"
by simp
from IH[OF ‹msx' = targetnode a # ms› this]
have "ms = ms'" and "get_proc (targetnode a) = get_proc m'" by simp_all
moreover
from ‹valid_edge a› ‹intra_kind (kind a)›
have "get_proc (sourcenode a) = get_proc (targetnode a)" by(rule get_proc_intra)
moreover
from ‹hd (m # ms) = sourcenode a› have "m = sourcenode a" by simp
ultimately show ?case using ‹ms = ms'› by simp
qed (auto simp:intra_kind_def)
qed simp
lemma silent_moves_nodestack_notempty:
"⟦S,f ⊢ (ms,s) =as⇒⇩τ (ms',s'); ms ≠ []⟧ ⟹ ms' ≠ []"
apply(induct S f ms s as ms' s' rule:silent_moves.induct) apply auto
apply(erule silent_move.cases) apply auto
apply(case_tac "tl msa") by auto
lemma silent_moves_obs_slice:
"⟦S,kind ⊢ (ms,s) =as⇒⇩τ (ms',s'); mx ∈ obs ms' ⌊HRB_slice S⌋⇘CFG⇙;
∀n ∈ set (tl ms'). return_node n⟧
⟹ mx ∈ obs ms ⌊HRB_slice S⌋⇘CFG⇙ ∧ (∀n ∈ set (tl ms). return_node n)"
proof(induct S f≡"kind" ms s as ms' s' rule:silent_moves.induct)
case silent_moves_Nil thus ?case by simp
next
case (silent_moves_Cons S ms s a ms' s' as ms'' s'')
note IH = ‹⟦mx ∈ obs ms'' ⌊HRB_slice S⌋⇘CFG⇙; ∀m∈set (tl ms''). return_node m⟧
⟹ mx ∈ obs ms' ⌊HRB_slice S⌋⇘CFG⇙ ∧ (∀m∈set (tl ms'). return_node m)›
from IH[OF ‹mx ∈ obs ms'' ⌊HRB_slice S⌋⇘CFG⇙› ‹∀m∈set (tl ms''). return_node m›]
have "mx ∈ obs ms' ⌊HRB_slice S⌋⇘CFG⇙" and "∀m∈set (tl ms'). return_node m"
by simp_all
with ‹S,kind ⊢ (ms,s) -a→⇩τ (ms',s')›
have "mx ∈ obs ms ⌊HRB_slice S⌋⇘CFG⇙" by(fastforce intro:silent_move_obs_slice)
moreover
from ‹S,kind ⊢ (ms,s) -a→⇩τ (ms',s')› have "∀m∈set (tl ms). return_node m"
by(fastforce elim:silent_move.cases)
ultimately show ?case by simp
qed
lemma silent_moves_empty_obs_slice:
"⟦S,f ⊢ (ms,s) =as⇒⇩τ (ms',s'); obs ms' ⌊HRB_slice S⌋⇘CFG⇙ = {}⟧
⟹ obs ms ⌊HRB_slice S⌋⇘CFG⇙ = {}"
proof(induct rule:silent_moves.induct)
case silent_moves_Nil thus ?case by simp
next
case (silent_moves_Cons S f ms s a ms' s' as ms'' s'')
note IH = ‹obs ms'' ⌊HRB_slice S⌋⇘CFG⇙ = {} ⟹ obs ms' ⌊HRB_slice S⌋⇘CFG⇙ = {}›
from IH[OF ‹obs ms'' ⌊HRB_slice S⌋⇘CFG⇙ = {}›]
have "obs ms' ⌊HRB_slice S⌋⇘CFG⇙ = {}" by simp
with ‹S,f ⊢ (ms,s) -a→⇩τ (ms',s')›
show ?case by -(rule silent_move_empty_obs_slice,fastforce)
qed
lemma silent_moves_preds_transfers:
assumes "S,f ⊢ (ms,s) =as⇒⇩τ (ms',s')"
shows "preds (map f as) s" and "transfers (map f as) s = s'"
proof -
from ‹S,f ⊢ (ms,s) =as⇒⇩τ (ms',s')›
have "preds (map f as) s ∧ transfers (map f as) s = s'"
proof(induct rule:silent_moves.induct)
case silent_moves_Nil thus ?case by simp
next
case (silent_moves_Cons S f ms s a ms' s' as ms'' s'')
from ‹S,f ⊢ (ms,s) -a→⇩τ (ms',s')›
have "pred (f a) s" and "transfer (f a) s = s'" by(auto elim:silent_move.cases)
with ‹preds (map f as) s' ∧ transfers (map f as) s' = s''›
show ?case by fastforce
qed
thus "preds (map f as) s" and "transfers (map f as) s = s'" by simp_all
qed
lemma silent_moves_intra_path_obs:
assumes "m' ∈ obs_intra m ⌊HRB_slice S⌋⇘CFG⇙" and "length s = length (m#msx')"
and "∀m ∈ set msx'. return_node m"
obtains as' where "S,slice_kind S ⊢ (m#msx',s) =as'⇒⇩τ (m'#msx',s)"
proof(atomize_elim)
from ‹m' ∈ obs_intra m ⌊HRB_slice S⌋⇘CFG⇙›
obtain as where "m -as→⇩ι* m'" and "m' ∈ ⌊HRB_slice S⌋⇘CFG⇙"
by -(erule obs_intraE)
from ‹m -as→⇩ι* m'› obtain x where "distance m m' x" and "x ≤ length as"
by(erule every_path_distance)
from ‹distance m m' x› ‹m' ∈ obs_intra m ⌊HRB_slice S⌋⇘CFG⇙›
‹length s = length (m#msx')› ‹∀m ∈ set msx'. return_node m›
show "∃as. S,slice_kind S ⊢ (m#msx',s) =as⇒⇩τ (m'#msx',s)"
proof(induct x arbitrary:m s rule:nat.induct)
fix m fix s::"(('var ⇀ 'val) × 'ret) list"
assume "distance m m' 0" and "length s = length (m#msx')"
then obtain as' where "m -as'→⇩ι* m'" and "length as' = 0"
by(auto elim:distance.cases)
hence "m -[]→⇩ι* m'" by(cases as) auto
hence [simp]:"m = m'" by(fastforce elim:path.cases simp:intra_path_def)
with ‹length s = length (m#msx')›[THEN sym]
have "S,slice_kind S ⊢ (m#msx',s) =[]⇒⇩τ (m#msx',s)"
by -(rule silent_moves_Nil)
thus "∃as. S,slice_kind S ⊢ (m#msx',s) =as⇒⇩τ (m'#msx',s)" by simp blast
next
fix x m fix s::"(('var ⇀ 'val) × 'ret) list"
assume "distance m m' (Suc x)" and "m' ∈ obs_intra m ⌊HRB_slice S⌋⇘CFG⇙"
and "length s = length (m#msx')" and "∀m ∈ set msx'. return_node m"
and IH:"⋀m s. ⟦distance m m' x; m' ∈ obs_intra m ⌊HRB_slice S⌋⇘CFG⇙;
length s = length (m#msx'); ∀m ∈ set msx'. return_node m⟧
⟹ ∃as. S,slice_kind S ⊢ (m#msx',s) =as⇒⇩τ (m'#msx',s)"
from ‹m' ∈ obs_intra m ⌊HRB_slice S⌋⇘CFG⇙› have "valid_node m"
by(rule in_obs_intra_valid)
with ‹distance m m' (Suc x)› have "m ≠ m'"
by(fastforce elim:distance.cases dest:empty_path simp:intra_path_def)
have "m ∉ ⌊HRB_slice S⌋⇘CFG⇙"
proof
assume isin:"m ∈ ⌊HRB_slice S⌋⇘CFG⇙"
with ‹valid_node m› have "obs_intra m ⌊HRB_slice S⌋⇘CFG⇙ = {m}"
by(fastforce intro!:n_in_obs_intra)
with ‹m' ∈ obs_intra m ⌊HRB_slice S⌋⇘CFG⇙› ‹m ≠ m'› show False by simp
qed
from ‹distance m m' (Suc x)› obtain a where "valid_edge a" and "m = sourcenode a"
and "intra_kind(kind a)" and "distance (targetnode a) m' x"
and target:"targetnode a = (SOME mx. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') m' x ∧
valid_edge a' ∧ intra_kind (kind a') ∧
targetnode a' = mx)"
by -(erule distance_successor_distance,simp+)
from ‹m' ∈ obs_intra m ⌊HRB_slice S⌋⇘CFG⇙›
have "obs_intra m ⌊HRB_slice S⌋⇘CFG⇙ = {m'}"
by(rule obs_intra_singleton_element)
with ‹valid_edge a› ‹m ∉ ⌊HRB_slice S⌋⇘CFG⇙› ‹m = sourcenode a› ‹intra_kind(kind a)›
have disj:"obs_intra (targetnode a) ⌊HRB_slice S⌋⇘CFG⇙ = {} ∨
obs_intra (targetnode a) ⌊HRB_slice S⌋⇘CFG⇙ = {m'}"
by -(drule_tac S="⌊HRB_slice S⌋⇘CFG⇙" in edge_obs_intra_subset,auto)
from ‹intra_kind(kind a)› ‹length s = length (m#msx')› ‹m ∉ ⌊HRB_slice S⌋⇘CFG⇙›
‹m = sourcenode a›
have length:"length (transfer (slice_kind S a) s) = length (targetnode a#msx')"
by(cases s)
(auto split:if_split_asm simp add:Let_def slice_kind_def intra_kind_def)
from ‹distance (targetnode a) m' x› obtain asx where "targetnode a -asx→⇩ι* m'"
and "length asx = x" and "∀as'. targetnode a -as'→⇩ι* m' ⟶ x ≤ length as'"
by(auto elim:distance.cases)
from ‹targetnode a -asx→⇩ι* m'› ‹m' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
obtain mx where "mx ∈ obs_intra (targetnode a) ⌊HRB_slice S⌋⇘CFG⇙"
by(erule path_ex_obs_intra)
with disj have "m' ∈ obs_intra (targetnode a) ⌊HRB_slice S⌋⇘CFG⇙" by fastforce
from IH[OF ‹distance (targetnode a) m' x› this length
‹∀m ∈ set msx'. return_node m›]
obtain asx' where moves:"S,slice_kind S ⊢
(targetnode a#msx',transfer (slice_kind S a) s) =asx'⇒⇩τ
(m'#msx',transfer (slice_kind S a) s)" by blast
have "pred (slice_kind S a) s ∧ transfer (slice_kind S a) s = s"
proof(cases "kind a")
fix f assume "kind a = ⇑f"
with ‹m ∉ ⌊HRB_slice S⌋⇘CFG⇙› ‹m = sourcenode a› have "slice_kind S a = ⇑id"
by(fastforce intro:slice_kind_Upd)
with ‹length s = length (m#msx')› show ?thesis by(cases s) auto
next
fix Q assume "kind a = (Q)⇩√"
with ‹m ∉ ⌊HRB_slice S⌋⇘CFG⇙› ‹m = sourcenode a›
‹m' ∈ obs_intra m ⌊HRB_slice S⌋⇘CFG⇙› ‹distance (targetnode a) m' x›
‹distance m m' (Suc x)› target
have "slice_kind S a = (λs. True)⇩√"
by(fastforce intro:slice_kind_Pred_obs_nearer_SOME)
with ‹length s = length (m#msx')› show ?thesis by(cases s) auto
next
fix Q r p fs assume "kind a = Q:r↪⇘p⇙fs"
with ‹intra_kind(kind a)› have False by(simp add:intra_kind_def)
thus ?thesis by simp
next
fix Q p f assume "kind a = Q↩⇘p⇙f"
with ‹intra_kind(kind a)› have False by(simp add:intra_kind_def)
thus ?thesis by simp
qed
hence "pred (slice_kind S a) s" and "transfer (slice_kind S a) s = s"
by simp_all
with ‹m ∉ ⌊HRB_slice S⌋⇘CFG⇙› ‹m = sourcenode a› ‹valid_edge a›
‹intra_kind(kind a)› ‹length s = length (m#msx')› ‹∀m ∈ set msx'. return_node m›
have "S,slice_kind S ⊢ (sourcenode a#msx',s) -a→⇩τ
(targetnode a#msx',transfer (slice_kind S a) s)"
by(fastforce intro:silent_move_intra)
with moves ‹transfer (slice_kind S a) s = s› ‹m = sourcenode a›
have "S,slice_kind S ⊢ (m#msx',s) =a#asx'⇒⇩τ (m'#msx',s)"
by(fastforce intro:silent_moves_Cons)
thus "∃as. S,slice_kind S ⊢ (m#msx',s) =as⇒⇩τ (m'#msx',s)" by blast
qed
qed
lemma silent_moves_intra_path_no_obs:
assumes "obs_intra m ⌊HRB_slice S⌋⇘CFG⇙ = {}" and "method_exit m'"
and "get_proc m = get_proc m'" and "valid_node m" and "length s = length (m#msx')"
and "∀m ∈ set msx'. return_node m"
obtains as where "S,slice_kind S ⊢ (m#msx',s) =as⇒⇩τ (m'#msx',s)"
proof(atomize_elim)
from ‹method_exit m'› ‹get_proc m = get_proc m'› ‹valid_node m›
obtain as where "m -as→⇩ι* m'" by(erule intra_path_to_matching_method_exit)
then obtain x where "distance m m' x" and "x ≤ length as"
by(erule every_path_distance)
from ‹distance m m' x› ‹m -as→⇩ι* m'› ‹obs_intra m ⌊HRB_slice S⌋⇘CFG⇙ = {}›
‹length s = length (m#msx')› ‹∀m ∈ set msx'. return_node m›
show "∃as. S,slice_kind S ⊢ (m#msx',s) =as⇒⇩τ (m'#msx',s)"
proof(induct x arbitrary:m as s rule:nat.induct)
fix m fix s::"(('var ⇀ 'val) × 'ret) list"
assume "distance m m' 0" and "length s = length (m#msx')"
then obtain as' where "m -as'→⇩ι* m'" and "length as' = 0"
by(auto elim:distance.cases)
hence "m -[]→⇩ι* m'" by(cases as) auto
hence [simp]:"m = m'" by(fastforce elim:path.cases simp:intra_path_def)
with ‹length s = length (m#msx')›[THEN sym]
have "S,slice_kind S ⊢ (m#msx',s) =[]⇒⇩τ (m#msx',s)"
by(fastforce intro:silent_moves_Nil)
thus "∃as. S,slice_kind S ⊢ (m#msx',s) =as⇒⇩τ (m'#msx',s)" by simp blast
next
fix x m as fix s::"(('var ⇀ 'val) × 'ret) list"
assume "distance m m' (Suc x)" and "m -as→⇩ι* m'"
and "obs_intra m ⌊HRB_slice S⌋⇘CFG⇙ = {}"
and "length s = length (m#msx')" and "∀m ∈ set msx'. return_node m"
and IH:"⋀m as s. ⟦distance m m' x; m -as→⇩ι* m';
obs_intra m ⌊HRB_slice S⌋⇘CFG⇙ = {}; length s = length (m#msx');
∀m ∈ set msx'. return_node m⟧
⟹ ∃as. S,slice_kind S ⊢ (m#msx',s) =as⇒⇩τ (m'#msx',s)"
from ‹m -as→⇩ι* m'› have "valid_node m"
by(fastforce intro:path_valid_node simp:intra_path_def)
from ‹m -as→⇩ι* m'› have "get_proc m = get_proc m'" by(rule intra_path_get_procs)
have "m ∉ ⌊HRB_slice S⌋⇘CFG⇙"
proof
assume "m ∈ ⌊HRB_slice S⌋⇘CFG⇙"
with ‹valid_node m› have "obs_intra m ⌊HRB_slice S⌋⇘CFG⇙ = {m}"
by(fastforce intro!:n_in_obs_intra)
with ‹obs_intra m ⌊HRB_slice S⌋⇘CFG⇙ = {}› show False by simp
qed
from ‹distance m m' (Suc x)› obtain a where "valid_edge a" and "m = sourcenode a"
and "intra_kind(kind a)" and "distance (targetnode a) m' x"
and target:"targetnode a = (SOME mx. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') m' x ∧
valid_edge a' ∧ intra_kind (kind a') ∧
targetnode a' = mx)"
by -(erule distance_successor_distance,simp+)
from ‹intra_kind(kind a)› ‹length s = length (m#msx')› ‹m ∉ ⌊HRB_slice S⌋⇘CFG⇙›
‹m = sourcenode a›
have length:"length (transfer (slice_kind S a) s) = length (targetnode a#msx')"
by(cases s)
(auto split:if_split_asm simp add:Let_def slice_kind_def intra_kind_def)
from ‹distance (targetnode a) m' x› obtain asx where "targetnode a -asx→⇩ι* m'"
and "length asx = x" and "∀as'. targetnode a -as'→⇩ι* m' ⟶ x ≤ length as'"
by(auto elim:distance.cases)
from ‹valid_edge a› ‹intra_kind(kind a)› ‹m ∉ ⌊HRB_slice S⌋⇘CFG⇙›
‹m = sourcenode a› ‹obs_intra m ⌊HRB_slice S⌋⇘CFG⇙ = {}›
have "obs_intra (targetnode a) ⌊HRB_slice S⌋⇘CFG⇙ = {}"
by(fastforce dest:edge_obs_intra_subset)
from IH[OF ‹distance (targetnode a) m' x› ‹targetnode a -asx→⇩ι* m'› this
length ‹∀m ∈ set msx'. return_node m›] obtain as'
where moves:"S,slice_kind S ⊢
(targetnode a#msx',transfer (slice_kind S a) s) =as'⇒⇩τ
(m'#msx',transfer (slice_kind S a) s)" by blast
have "pred (slice_kind S a) s ∧ transfer (slice_kind S a) s = s"
proof(cases "kind a")
fix f assume "kind a = ⇑f"
with ‹m ∉ ⌊HRB_slice S⌋⇘CFG⇙› ‹m = sourcenode a› have "slice_kind S a = ⇑id"
by(fastforce intro:slice_kind_Upd)
with ‹length s = length (m#msx')› show ?thesis by(cases s) auto
next
fix Q assume "kind a = (Q)⇩√"
with ‹m ∉ ⌊HRB_slice S⌋⇘CFG⇙› ‹m = sourcenode a›
‹obs_intra m ⌊HRB_slice S⌋⇘CFG⇙ = {}› ‹distance (targetnode a) m' x›
‹distance m m' (Suc x)› ‹method_exit m'› ‹get_proc m = get_proc m'› target
have "slice_kind S a = (λs. True)⇩√"
by(fastforce intro:slice_kind_Pred_empty_obs_nearer_SOME)
with ‹length s = length (m#msx')› show ?thesis by(cases s) auto
next
fix Q r p fs assume "kind a = Q:r↪⇘p⇙fs"
with ‹intra_kind(kind a)› have False by(simp add:intra_kind_def)
thus ?thesis by simp
next
fix Q p f assume "kind a = Q↩⇘p⇙f"
with ‹intra_kind(kind a)› have False by(simp add:intra_kind_def)
thus ?thesis by simp
qed
hence "pred (slice_kind S a) s" and "transfer (slice_kind S a) s = s"
by simp_all
with ‹m ∉ ⌊HRB_slice S⌋⇘CFG⇙› ‹m = sourcenode a› ‹valid_edge a›
‹intra_kind(kind a)› ‹length s = length (m#msx')› ‹∀m ∈ set msx'. return_node m›
have "S,slice_kind S ⊢ (sourcenode a#msx',s) -a→⇩τ
(targetnode a#msx',transfer (slice_kind S a) s)"
by(fastforce intro:silent_move_intra)
with moves ‹transfer (slice_kind S a) s = s› ‹m = sourcenode a›
have "S,slice_kind S ⊢ (m#msx',s) =a#as'⇒⇩τ (m'#msx',s)"
by(fastforce intro:silent_moves_Cons)
thus "∃as. S,slice_kind S ⊢ (m#msx',s) =as⇒⇩τ (m'#msx',s)" by blast
qed
qed
lemma silent_moves_vpa_path:
assumes "S,f ⊢ (m#ms,s) =as⇒⇩τ (m'#ms',s')" and "valid_node m"
and "∀i < length rs. rs!i ∈ get_return_edges (cs!i)"
and "ms = targetnodes rs" and "valid_return_list rs m"
and "length rs = length cs"
shows "m -as→* m'" and "valid_path_aux cs as"
proof -
from assms have "m -as→* m' ∧ valid_path_aux cs as"
proof(induct S f "m#ms" s as "m'#ms'" s' arbitrary:m cs ms rs
rule:silent_moves.induct)
case (silent_moves_Nil msx sx n⇩c f)
from ‹valid_node m'› have "m' -[]→* m'"
by (rule empty_path)
thus ?case by fastforce
next
case (silent_moves_Cons S f sx a msx' sx' as s'')
thus ?case
proof(induct _ _ "m # ms" _ _ _ _ rule:silent_move.induct)
case (silent_move_intra f a sx sx' n⇩c msx')
note IH = ‹⋀m cs ms rs. ⟦msx' = m # ms; valid_node m;
∀i<length rs. rs ! i ∈ get_return_edges (cs ! i);
ms = targetnodes rs; valid_return_list rs m;
length rs = length cs⟧
⟹ m -as→* m' ∧ valid_path_aux cs as›
from ‹msx' = targetnode a # tl (m # ms)›
have "msx' = targetnode a # ms" by simp
from ‹valid_edge a› ‹intra_kind (kind a)›
have "get_proc (sourcenode a) = get_proc (targetnode a)"
by(rule get_proc_intra)
with ‹valid_return_list rs m› ‹hd (m # ms) = sourcenode a›
have "valid_return_list rs (targetnode a)"
apply(clarsimp simp:valid_return_list_def)
apply(erule_tac x="cs'" in allE) apply clarsimp
by(case_tac cs') auto
from ‹valid_edge a› have "valid_node (targetnode a)" by simp
from IH[OF ‹msx' = targetnode a # ms› this
‹∀i<length rs. rs ! i ∈ get_return_edges (cs ! i)›
‹ms = targetnodes rs› ‹valid_return_list rs (targetnode a)›
‹length rs = length cs›]
have "targetnode a -as→* m'" and "valid_path_aux cs as" by simp_all
from ‹valid_edge a› ‹targetnode a -as→* m'›
‹hd (m # ms) = sourcenode a›
have "m -a#as→* m'" by(fastforce intro:Cons_path)
moreover
from ‹intra_kind (kind a)› ‹valid_path_aux cs as›
have "valid_path_aux cs (a # as)" by(fastforce simp:intra_kind_def)
ultimately show ?case by simp
next
case (silent_move_call f a sx sx' Q r p fs a' n⇩c msx')
note IH = ‹⋀m cs ms rs. ⟦msx' = m # ms; valid_node m;
∀i<length rs. rs ! i ∈ get_return_edges (cs ! i);
ms = targetnodes rs; valid_return_list rs m;
length rs = length cs⟧
⟹ m -as→* m' ∧ valid_path_aux cs as›
from ‹valid_edge a› have "valid_node (targetnode a)" by simp
from ‹length rs = length cs›
have "length (a'#rs) = length (a#cs)" by simp
from ‹msx' = targetnode a # targetnode a' # tl (m # ms)›
have "msx' = targetnode a # targetnode a' # ms" by simp
from ‹ms = targetnodes rs› have "targetnode a' # ms = targetnodes (a' # rs)"
by(simp add:targetnodes_def)
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› have "get_proc (targetnode a) = p"
by(rule get_proc_call)
from ‹valid_edge a› ‹a' ∈ get_return_edges a› have "valid_edge a'"
by(rule get_return_edges_valid)
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹a' ∈ get_return_edges a›
obtain Q' f' where "kind a' = Q'↩⇘p⇙f'" by(fastforce dest!:call_return_edges)
from ‹valid_edge a› ‹a' ∈ get_return_edges a›
have "get_proc (sourcenode a) = get_proc (targetnode a')"
by(rule get_proc_get_return_edge)
with ‹valid_return_list rs m› ‹hd (m # ms) = sourcenode a›
‹get_proc (targetnode a) = p› ‹valid_edge a'› ‹kind a' = Q'↩⇘p⇙f'›
have "valid_return_list (a' # rs) (targetnode a)"
apply(clarsimp simp:valid_return_list_def)
apply(case_tac cs') apply auto
apply(erule_tac x="list" in allE) apply clarsimp
by(case_tac list)(auto simp:targetnodes_def)
from ‹∀i<length rs. rs ! i ∈ get_return_edges (cs ! i)›
‹a' ∈ get_return_edges a›
have "∀i<length (a'#rs). (a'#rs) ! i ∈ get_return_edges ((a#cs) ! i)"
by auto(case_tac i,auto)
from IH[OF ‹msx' = targetnode a # targetnode a' # ms› ‹valid_node (targetnode a)› this
‹targetnode a' # ms = targetnodes (a' # rs)›
‹valid_return_list (a' # rs) (targetnode a)› ‹length (a'#rs) = length (a#cs)›]
have "targetnode a -as→* m'" and "valid_path_aux (a # cs) as" by simp_all
from ‹valid_edge a› ‹targetnode a -as→* m'›
‹hd (m # ms) = sourcenode a›
have "m -a#as→* m'" by(fastforce intro:Cons_path)
moreover
from ‹valid_path_aux (a # cs) as› ‹kind a = Q:r↪⇘p⇙fs›
have "valid_path_aux cs (a # as)" by simp
ultimately show ?case by simp
next
case (silent_move_return f a sx sx' Q p f' n⇩c msx')
note IH = ‹⋀m cs ms rs. ⟦msx' = m # ms; valid_node m;
∀i<length rs. rs ! i ∈ get_return_edges (cs ! i);
ms = targetnodes rs; valid_return_list rs m;
length rs = length cs⟧
⟹ m -as→* m' ∧ valid_path_aux cs as›
from ‹valid_edge a› have "valid_node (targetnode a)" by simp
from ‹length (m # ms) = length sx› ‹length sx = Suc (length sx')›
‹sx' ≠ []›
obtain x xs where "ms = x#xs" by(cases ms) auto
with ‹ms = targetnodes rs› obtain r' rs' where "rs = r'#rs'"
and "x = targetnode r'" and "xs = targetnodes rs'"
by(auto simp:targetnodes_def)
with ‹length rs = length cs› obtain c' cs' where "cs = c'#cs'"
and "length rs' = length cs'"
by(cases cs) auto
from ‹ms = x#xs› ‹length (m # ms) = length sx›
‹length sx = Suc (length sx')›
have "length sx' = Suc (length xs)" by simp
from ‹ms = x#xs› ‹msx' = tl (m # ms)› ‹hd (tl (m # ms)) = targetnode a›
‹length (m # ms) = length sx› ‹length sx = Suc (length sx')› ‹sx' ≠ []›
have "msx' = targetnode a#xs" by simp
from ‹∀i<length rs. rs ! i ∈ get_return_edges (cs ! i)›
‹rs = r'#rs'› ‹cs = c'#cs'›
have "r' ∈ get_return_edges c'" by fastforce
from ‹ms = x#xs› ‹hd (tl (m # ms)) = targetnode a›
have "x = targetnode a" by simp
with ‹valid_return_list rs m› ‹rs = r'#rs'› ‹x = targetnode r'›
have "valid_return_list rs' (targetnode a)"
apply(clarsimp simp:valid_return_list_def)
apply(erule_tac x="r'#cs'" in allE) apply clarsimp
by(case_tac cs')(auto simp:targetnodes_def)
from ‹∀i<length rs. rs ! i ∈ get_return_edges (cs ! i)›
‹rs = r'#rs'› ‹cs = c'#cs'›
have "∀i<length rs'. rs' ! i ∈ get_return_edges (cs' ! i)"
and "r' ∈ get_return_edges c'" by auto
from IH[OF ‹msx' = targetnode a#xs› ‹valid_node (targetnode a)›
‹∀i<length rs'. rs' ! i ∈ get_return_edges (cs' ! i)› ‹xs = targetnodes rs'›
‹valid_return_list rs' (targetnode a)› ‹length rs' = length cs'›]
have "targetnode a -as→* m'" and "valid_path_aux cs' as" by simp_all
from ‹valid_edge a› ‹targetnode a -as→* m'›
‹hd (m # ms) = sourcenode a›
have "m -a#as→* m'" by(fastforce intro:Cons_path)
moreover
from ‹ms = x#xs› ‹hd (tl (m # ms)) = targetnode a›
have "x = targetnode a" by simp
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f'›
have "method_exit (sourcenode a)" by(fastforce simp:method_exit_def)
from ‹valid_return_list rs m› ‹hd (m # ms) = sourcenode a›
‹rs = r'#rs'›
have "get_proc (sourcenode a) = get_proc (sourcenode r') ∧
method_exit (sourcenode r') ∧ valid_edge r'"
apply(clarsimp simp:valid_return_list_def method_exit_def)
apply(erule_tac x="[]" in allE)
by(auto dest:get_proc_return)
hence "get_proc (sourcenode a) = get_proc (sourcenode r')"
and "method_exit (sourcenode r')" and "valid_edge r'" by simp_all
with ‹method_exit (sourcenode a)› have "sourcenode r' = sourcenode a"
by(fastforce intro:method_exit_unique)
with ‹valid_edge a› ‹valid_edge r'› ‹x = targetnode r'› ‹x = targetnode a›
have "r' = a" by(fastforce intro:edge_det)
with ‹r' ∈ get_return_edges c'› ‹valid_path_aux cs' as› ‹cs = c'#cs'›
‹kind a = Q↩⇘p⇙f'›
have "valid_path_aux cs (a # as)" by simp
ultimately show ?case by simp
qed
qed
thus "m -as→* m'" and "valid_path_aux cs as" by simp_all
qed
subsection ‹Observable moves›
inductive observable_move ::
"'node SDG_node set ⇒ ('edge ⇒ ('var,'val,'ret,'pname) edge_kind) ⇒ 'node list ⇒
(('var ⇀ 'val) × 'ret) list ⇒ 'edge ⇒ 'node list ⇒ (('var ⇀ 'val) × 'ret) list ⇒ bool"
("_,_ ⊢ '(_,_') -_→ '(_,_')" [51,50,0,0,50,0,0] 51)
where observable_move_intra:
"⟦pred (f a) s; transfer (f a) s = s'; valid_edge a; intra_kind(kind a);
∀m ∈ set (tl ms). ∃m'. call_of_return_node m m' ∧ m' ∈ ⌊HRB_slice S⌋⇘CFG⇙;
hd ms ∈ ⌊HRB_slice S⌋⇘CFG⇙; length s' = length s; length ms = length s;
hd ms = sourcenode a; ms' = (targetnode a)#tl ms⟧
⟹ S,f ⊢ (ms,s) -a→ (ms',s')"
| observable_move_call:
"⟦pred (f a) s; transfer (f a) s = s'; valid_edge a; kind a = Q:r↪⇘p⇙fs;
valid_edge a'; a' ∈ get_return_edges a;
∀m ∈ set (tl ms). ∃m'. call_of_return_node m m' ∧ m' ∈ ⌊HRB_slice S⌋⇘CFG⇙;
hd ms ∈ ⌊HRB_slice S⌋⇘CFG⇙; length ms = length s; length s' = Suc(length s);
hd ms = sourcenode a; ms' = (targetnode a)#(targetnode a')#tl ms⟧
⟹ S,f ⊢ (ms,s) -a→ (ms',s')"
| observable_move_return:
"⟦pred (f a) s; transfer (f a) s = s'; valid_edge a; kind a = Q↩⇘p⇙f';
∀m ∈ set (tl ms). ∃m'. call_of_return_node m m' ∧ m' ∈ ⌊HRB_slice S⌋⇘CFG⇙;
length ms = length s; length s = Suc(length s'); s' ≠ [];
hd ms = sourcenode a; hd(tl ms) = targetnode a; ms' = tl ms⟧
⟹ S,f ⊢ (ms,s) -a→ (ms',s')"
inductive observable_moves ::
"'node SDG_node set ⇒ ('edge ⇒ ('var,'val,'ret,'pname) edge_kind) ⇒ 'node list ⇒
(('var ⇀ 'val) × 'ret) list ⇒ 'edge list ⇒ 'node list ⇒ (('var ⇀ 'val) × 'ret) list ⇒ bool"
("_,_ ⊢ '(_,_') =_⇒ '(_,_')" [51,50,0,0,50,0,0] 51)
where observable_moves_snoc:
"⟦S,f ⊢ (ms,s) =as⇒⇩τ (ms',s'); S,f ⊢ (ms',s') -a→ (ms'',s'')⟧
⟹ S,f ⊢ (ms,s) =as@[a]⇒ (ms'',s'')"
lemma observable_move_equal_length:
assumes "S,f ⊢ (ms,s) -a→ (ms',s')"
shows "length ms = length s" and "length ms' = length s'"
proof -
from ‹S,f ⊢ (ms,s) -a→ (ms',s')›
have "length ms = length s ∧ length ms' = length s'"
proof(induct rule:observable_move.induct)
case (observable_move_intra f a s s' ms S ms')
from ‹pred (f a) s› obtain cf cfs where [simp]:"s = cf#cfs" by(cases s) auto
from ‹length ms = length s› ‹ms' = targetnode a # tl ms›
‹length s' = length s› show ?case by simp
next
case (observable_move_call f a s s' Q r p fs a' ms S ms')
from ‹pred (f a) s› obtain cf cfs where [simp]:"s = cf#cfs" by(cases s) auto
from ‹length ms = length s› ‹length s' = Suc (length s)›
‹ms' = targetnode a # targetnode a' # tl ms› show ?case by simp
next
case (observable_move_return f a s s' Q p f' ms S ms')
from ‹length ms = length s› ‹length s = Suc (length s')› ‹ms' = tl ms› ‹s' ≠ []›
show ?case by simp
qed
thus "length ms = length s" and "length ms' = length s'" by simp_all
qed
lemma observable_moves_equal_length:
assumes "S,f ⊢ (ms,s) =as⇒ (ms',s')"
shows "length ms = length s" and "length ms' = length s'"
using ‹S,f ⊢ (ms,s) =as⇒ (ms',s')›
proof(induct rule:observable_moves.induct)
case (observable_moves_snoc S f ms s as ms' s' a ms'' s'')
from ‹S,f ⊢ (ms',s') -a→ (ms'',s'')›
have "length ms' = length s'" "length ms'' = length s''"
by(rule observable_move_equal_length)+
moreover
from ‹S,f ⊢ (ms,s) =as⇒⇩τ (ms',s')›
have "length ms = length s" and "length ms' = length s'"
by(rule silent_moves_equal_length)+
ultimately show "length ms = length s" "length ms'' = length s''" by simp_all
qed
lemma observable_move_notempty:
"⟦S,f ⊢ (ms,s) =as⇒ (ms',s'); as = []⟧ ⟹ False"
by(induct rule:observable_moves.induct,simp)
lemma silent_move_observable_moves:
"⟦S,f ⊢ (ms'',s'') =as⇒ (ms',s'); S,f ⊢ (ms,s) -a→⇩τ (ms'',s'')⟧
⟹ S,f ⊢ (ms,s) =a#as⇒ (ms',s')"
proof(induct rule:observable_moves.induct)
case (observable_moves_snoc S f msx sx as ms' s' a' ms'' s'')
from ‹S,f ⊢ (ms,s) -a→⇩τ (msx,sx)› ‹S,f ⊢ (msx,sx) =as⇒⇩τ (ms',s')›
have "S,f ⊢ (ms,s) =a#as⇒⇩τ (ms',s')" by(fastforce intro:silent_moves_Cons)
with ‹S,f ⊢ (ms',s') -a'→ (ms'',s'')›
have "S,f ⊢ (ms,s) =(a#as)@[a']⇒ (ms'',s'')"
by(fastforce intro:observable_moves.observable_moves_snoc)
thus ?case by simp
qed
lemma silent_append_observable_moves:
"⟦S,f ⊢ (ms,s) =as⇒⇩τ (ms'',s''); S,f ⊢ (ms'',s'') =as'⇒ (ms',s')⟧
⟹ S,f ⊢ (ms,s) =as@as'⇒ (ms',s')"
by(induct rule:silent_moves.induct)(auto elim:silent_move_observable_moves)
lemma observable_moves_preds_transfers:
assumes "S,f ⊢ (ms,s) =as⇒ (ms',s')"
shows "preds (map f as) s" and "transfers (map f as) s = s'"
proof -
from ‹S,f ⊢ (ms,s) =as⇒ (ms',s')›
have "preds (map f as) s ∧ transfers (map f as) s = s'"
proof(induct rule:observable_moves.induct)
case (observable_moves_snoc S f ms s as ms' s' a ms'' s'')
from ‹S,f ⊢ (ms,s) =as⇒⇩τ (ms',s')›
have "preds (map f as) s" and "transfers (map f as) s = s'"
by(rule silent_moves_preds_transfers)+
from ‹S,f ⊢ (ms',s') -a→ (ms'',s'')›
have "pred (f a) s'" and "transfer (f a) s' = s''"
by(auto elim:observable_move.cases)
with ‹preds (map f as) s› ‹transfers (map f as) s = s'›
show ?case by(simp add:preds_split transfers_split)
qed
thus "preds (map f as) s" and "transfers (map f as) s = s'" by simp_all
qed
lemma observable_move_vpa_path:
"⟦S,f ⊢ (m#ms,s) -a→ (m'#ms',s'); valid_node m;
∀i < length rs. rs!i ∈ get_return_edges (cs!i); ms = targetnodes rs;
valid_return_list rs m; length rs = length cs⟧ ⟹ valid_path_aux cs [a]"
proof(induct S f "m#ms" s a "m'#ms'" s' rule:observable_move.induct)
case (observable_move_return f a sx sx' Q p f' n⇩c)
from ‹length (m # ms) = length sx› ‹length sx = Suc (length sx')›
‹sx' ≠ []›
obtain x xs where "ms = x#xs" by(cases ms) auto
with ‹ms = targetnodes rs› obtain r' rs' where "rs = r'#rs'"
and "x = targetnode r'" and "xs = targetnodes rs'"
by(auto simp:targetnodes_def)
with ‹length rs = length cs› obtain c' cs' where "cs = c'#cs'"
and "length rs' = length cs'"
by(cases cs) auto
from ‹∀i<length rs. rs ! i ∈ get_return_edges (cs ! i)›
‹rs = r'#rs'› ‹cs = c'#cs'›
have "∀i<length rs'. rs' ! i ∈ get_return_edges (cs' ! i)"
and "r' ∈ get_return_edges c'" by auto
from ‹ms = x#xs› ‹hd (tl (m # ms)) = targetnode a›
have "x = targetnode a" by simp
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f'›
have "method_exit (sourcenode a)" by(fastforce simp:method_exit_def)
from ‹valid_return_list rs m› ‹hd (m # ms) = sourcenode a›
‹rs = r'#rs'›
have "get_proc (sourcenode a) = get_proc (sourcenode r') ∧
method_exit (sourcenode r') ∧ valid_edge r'"
apply(clarsimp simp:valid_return_list_def method_exit_def)
apply(erule_tac x="[]" in allE)
by(auto dest:get_proc_return)
hence "get_proc (sourcenode a) = get_proc (sourcenode r')"
and "method_exit (sourcenode r')" and "valid_edge r'" by simp_all
with ‹method_exit (sourcenode a)› have "sourcenode r' = sourcenode a"
by(fastforce intro:method_exit_unique)
with ‹valid_edge a› ‹valid_edge r'› ‹x = targetnode r'› ‹x = targetnode a›
have "r' = a" by(fastforce intro:edge_det)
with ‹r' ∈ get_return_edges c'› ‹cs = c'#cs'› ‹kind a = Q↩⇘p⇙f'›
show ?case by simp
qed(auto simp:intra_kind_def)
subsection ‹Relevant variables›
inductive_set relevant_vars ::
"'node SDG_node set ⇒ 'node SDG_node ⇒ 'var set" ("rv _")
for S :: "'node SDG_node set" and n :: "'node SDG_node"
where rvI:
"⟦parent_node n -as→⇩ι* parent_node n'; n' ∈ HRB_slice S; V ∈ Use⇘SDG⇙ n';
∀n''. valid_SDG_node n'' ∧ parent_node n'' ∈ set (sourcenodes as)
⟶ V ∉ Def⇘SDG⇙ n''⟧
⟹ V ∈ rv S n"
lemma rvE:
assumes rv:"V ∈ rv S n"
obtains as n' where "parent_node n -as→⇩ι* parent_node n'"
and "n' ∈ HRB_slice S" and "V ∈ Use⇘SDG⇙ n'"
and "∀n''. valid_SDG_node n'' ∧ parent_node n'' ∈ set (sourcenodes as)
⟶ V ∉ Def⇘SDG⇙ n''"
using rv
by(atomize_elim,auto elim!:relevant_vars.cases)
lemma rv_parent_node:
"parent_node n = parent_node n' ⟹ rv (S::'node SDG_node set) n = rv S n'"
by(fastforce elim:rvE intro:rvI)
lemma obs_intra_empty_rv_empty:
assumes "obs_intra m ⌊HRB_slice S⌋⇘CFG⇙ = {}" shows "rv S (CFG_node m) = {}"
proof(rule ccontr)
assume "rv S (CFG_node m) ≠ {}"
then obtain x where "x ∈ rv S (CFG_node m)" by fastforce
then obtain n' as where "m -as→⇩ι* parent_node n'" and "n' ∈ HRB_slice S"
by(fastforce elim:rvE)
hence "parent_node n' ∈ ⌊HRB_slice S⌋⇘CFG⇙"
by(fastforce intro:valid_SDG_node_in_slice_parent_node_in_slice
simp:SDG_to_CFG_set_def)
with ‹m -as→⇩ι* parent_node n'› obtain mx where "mx ∈ obs_intra m ⌊HRB_slice S⌋⇘CFG⇙"
by(erule path_ex_obs_intra)
with ‹obs_intra m ⌊HRB_slice S⌋⇘CFG⇙ = {}› show False by simp
qed
lemma eq_obs_intra_in_rv:
assumes obs_eq:"obs_intra (parent_node n) ⌊HRB_slice S⌋⇘CFG⇙ =
obs_intra (parent_node n') ⌊HRB_slice S⌋⇘CFG⇙"
and "x ∈ rv S n" shows "x ∈ rv S n'"
proof -
from ‹x ∈ rv S n› obtain as n''
where "parent_node n -as→⇩ι* parent_node n''" and "n'' ∈ HRB_slice S"
and "x ∈ Use⇘SDG⇙ n''"
and "∀n''. valid_SDG_node n'' ∧ parent_node n'' ∈ set (sourcenodes as)
⟶ x ∉ Def⇘SDG⇙ n''"
by(erule rvE)
from ‹parent_node n -as→⇩ι* parent_node n''› have "valid_node (parent_node n'')"
by(fastforce dest:path_valid_node simp:intra_path_def)
from ‹parent_node n -as→⇩ι* parent_node n''› ‹n'' ∈ HRB_slice S›
have "∃nx as' as''. parent_node nx ∈ obs_intra (parent_node n) ⌊HRB_slice S⌋⇘CFG⇙ ∧
parent_node n -as'→⇩ι* parent_node nx ∧
parent_node nx -as''→⇩ι* parent_node n'' ∧ as = as'@as''"
proof(cases "∀nx. parent_node nx ∈ set (sourcenodes as) ⟶ nx ∉ HRB_slice S")
case True
with ‹parent_node n -as→⇩ι* parent_node n''› ‹n'' ∈ HRB_slice S›
have "parent_node n'' ∈ obs_intra (parent_node n) ⌊HRB_slice S⌋⇘CFG⇙"
by(fastforce intro:obs_intra_elem valid_SDG_node_in_slice_parent_node_in_slice
simp:SDG_to_CFG_set_def)
with ‹parent_node n -as→⇩ι* parent_node n''› ‹valid_node (parent_node n'')›
show ?thesis by(fastforce intro:empty_path simp:intra_path_def)
next
case False
hence "∃nx. parent_node nx ∈ set (sourcenodes as) ∧ nx ∈ HRB_slice S" by simp
hence "∃mx ∈ set (sourcenodes as). ∃nx. mx = parent_node nx ∧ nx ∈ HRB_slice S"
by fastforce
then obtain mx ms ms' where "sourcenodes as = ms@mx#ms'"
and "∃nx. mx = parent_node nx ∧ nx ∈ HRB_slice S"
and all:"∀x ∈ set ms. ¬ (∃nx. x = parent_node nx ∧ nx ∈ HRB_slice S)"
by(fastforce elim!:split_list_first_propE)
then obtain nx' where "mx = parent_node nx'" and "nx' ∈ HRB_slice S" by blast
from ‹sourcenodes as = ms@mx#ms'›
obtain as' a' as'' where "ms = sourcenodes as'"
and [simp]:"as = as'@a'#as''" and "sourcenode a' = mx"
by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
from all ‹ms = sourcenodes as'›
have "∀nx∈set (sourcenodes as'). nx ∉ ⌊HRB_slice S⌋⇘CFG⇙"
by(fastforce simp:SDG_to_CFG_set_def)
from ‹parent_node n -as→⇩ι* parent_node n''› ‹sourcenode a' = mx›
have "parent_node n -as'→⇩ι* mx" and "valid_edge a'" and "intra_kind(kind a')"
and "targetnode a' -as''→⇩ι* parent_node n''"
by(fastforce dest:path_split simp:intra_path_def)+
with ‹sourcenode a' = mx› have "mx -a'#as''→⇩ι* parent_node n''"
by(fastforce intro:Cons_path simp:intra_path_def)
from ‹parent_node n -as'→⇩ι* mx› ‹mx = parent_node nx'› ‹nx' ∈ HRB_slice S›
‹∀nx∈set (sourcenodes as'). nx ∉ ⌊HRB_slice S⌋⇘CFG⇙› ‹ms = sourcenodes as'›
have "mx ∈ obs_intra (parent_node n) ⌊HRB_slice S⌋⇘CFG⇙"
by(fastforce intro:obs_intra_elem valid_SDG_node_in_slice_parent_node_in_slice
simp:SDG_to_CFG_set_def)
with ‹parent_node n -as'→⇩ι* mx› ‹mx -a'#as''→⇩ι* parent_node n''›
‹mx = parent_node nx'›
show ?thesis by simp blast
qed
then obtain nx as' as''
where "parent_node nx ∈ obs_intra (parent_node n) ⌊HRB_slice S⌋⇘CFG⇙"
and "parent_node n -as'→⇩ι* parent_node nx"
and "parent_node nx -as''→⇩ι* parent_node n''" and [simp]:"as = as'@as''"
by blast
from ‹parent_node nx ∈ obs_intra (parent_node n) ⌊HRB_slice S⌋⇘CFG⇙› obs_eq
have "parent_node nx ∈ obs_intra (parent_node n') ⌊HRB_slice S⌋⇘CFG⇙" by auto
then obtain asx where "parent_node n' -asx→⇩ι* parent_node nx"
and "∀ni ∈ set(sourcenodes asx). ni ∉ ⌊HRB_slice S⌋⇘CFG⇙"
and "parent_node nx ∈ ⌊HRB_slice S⌋⇘CFG⇙"
by(erule obs_intraE)
from ‹∀n''. valid_SDG_node n'' ∧ parent_node n'' ∈ set (sourcenodes as)
⟶ x ∉ Def⇘SDG⇙ n''›
have "∀ni. valid_SDG_node ni ∧ parent_node ni ∈ set (sourcenodes as'')
⟶ x ∉ Def⇘SDG⇙ ni"
by(auto simp:sourcenodes_def)
from ‹∀ni ∈ set(sourcenodes asx). ni ∉ ⌊HRB_slice S⌋⇘CFG⇙›
‹parent_node n' -asx→⇩ι* parent_node nx›
have "∀ni. valid_SDG_node ni ∧ parent_node ni ∈ set (sourcenodes asx)
⟶ x ∉ Def⇘SDG⇙ ni"
proof(induct asx arbitrary:n')
case Nil thus ?case by(simp add:sourcenodes_def)
next
case (Cons ax' asx')
note IH = ‹⋀n'. ⟦∀ni∈set (sourcenodes asx'). ni ∉ ⌊HRB_slice S⌋⇘CFG⇙;
parent_node n' -asx'→⇩ι* parent_node nx⟧
⟹ ∀ni. valid_SDG_node ni ∧ parent_node ni ∈ set (sourcenodes asx')
⟶ x ∉ Def⇘SDG⇙ ni›
from ‹parent_node n' -ax'#asx'→⇩ι* parent_node nx›
have "parent_node n' -[]@ax'#asx'→* parent_node nx"
and "∀a ∈ set (ax'#asx'). intra_kind(kind a)" by(simp_all add:intra_path_def)
hence "targetnode ax' -asx'→* parent_node nx" and "valid_edge ax'"
and "parent_node n' = sourcenode ax'" by(fastforce dest:path_split)+
with ‹∀a ∈ set (ax'#asx'). intra_kind(kind a)›
have path:"parent_node (CFG_node (targetnode ax')) -asx'→⇩ι* parent_node nx"
by(simp add:intra_path_def)
from ‹∀ni∈set (sourcenodes (ax'#asx')). ni ∉ ⌊HRB_slice S⌋⇘CFG⇙›
have all:"∀ni∈set (sourcenodes asx'). ni ∉ ⌊HRB_slice S⌋⇘CFG⇙"
and "sourcenode ax' ∉ ⌊HRB_slice S⌋⇘CFG⇙"
by(auto simp:sourcenodes_def)
from IH[OF all path]
have "∀ni. valid_SDG_node ni ∧ parent_node ni ∈ set (sourcenodes asx')
⟶ x ∉ Def⇘SDG⇙ ni" .
with ‹∀ni. valid_SDG_node ni ∧ parent_node ni ∈ set (sourcenodes as'')
⟶ x ∉ Def⇘SDG⇙ ni›
have all:"∀ni. valid_SDG_node ni ∧ parent_node ni ∈ set (sourcenodes (asx'@as''))
⟶ x ∉ Def⇘SDG⇙ ni"
by(auto simp:sourcenodes_def)
from ‹parent_node n' -ax'#asx'→⇩ι* parent_node nx›
‹parent_node nx -as''→⇩ι* parent_node n''›
have path:"parent_node n' -ax'#asx'@as''→⇩ι* parent_node n''"
by(fastforce intro:path_Append[of _ "ax'#asx'",simplified] simp:intra_path_def)
have "∀nx'. parent_node nx' = sourcenode ax' ⟶ x ∉ Def⇘SDG⇙ nx'"
proof
fix nx'
show "parent_node nx' = sourcenode ax' ⟶ x ∉ Def⇘SDG⇙ nx'"
proof
assume "parent_node nx' = sourcenode ax'"
show "x ∉ Def⇘SDG⇙ nx'"
proof
assume "x ∈ Def⇘SDG⇙ nx'"
from ‹parent_node n' = sourcenode ax'› ‹parent_node nx' = sourcenode ax'›
have "parent_node nx' = parent_node n'" by simp
with ‹x ∈ Def⇘SDG⇙ nx'› ‹x ∈ Use⇘SDG⇙ n''› all path
have "nx' influences x in n''" by(fastforce simp:data_dependence_def)
hence "nx' s-x→⇩d⇩d n''" by(rule sum_SDG_ddep_edge)
with ‹n'' ∈ HRB_slice S› have "nx' ∈ HRB_slice S"
by(fastforce elim:combine_SDG_slices.cases
intro:combine_SDG_slices.intros ddep_slice1 ddep_slice2
simp:HRB_slice_def)
hence "CFG_node (parent_node nx') ∈ HRB_slice S"
by(rule valid_SDG_node_in_slice_parent_node_in_slice)
with ‹sourcenode ax' ∉ ⌊HRB_slice S⌋⇘CFG⇙› ‹parent_node n' = sourcenode ax'›
‹parent_node nx' = sourcenode ax'› show False
by(simp add:SDG_to_CFG_set_def)
qed
qed
qed
with all show ?case by(auto simp add:sourcenodes_def)
qed
with ‹∀ni. valid_SDG_node ni ∧ parent_node ni ∈ set (sourcenodes as'')
⟶ x ∉ Def⇘SDG⇙ ni›
have all:"∀ni. valid_SDG_node ni ∧ parent_node ni ∈ set (sourcenodes (asx@as''))
⟶ x ∉ Def⇘SDG⇙ ni"
by(auto simp:sourcenodes_def)
with ‹parent_node n' -asx→⇩ι* parent_node nx›
‹parent_node nx -as''→⇩ι* parent_node n''›
have "parent_node n' -asx@as''→⇩ι* parent_node n''"
by(fastforce intro:path_Append simp:intra_path_def)
from this ‹n'' ∈ HRB_slice S› ‹x ∈ Use⇘SDG⇙ n''› all
show "x ∈ rv S n'" by(rule rvI)
qed
lemma closed_eq_obs_eq_rvs:
fixes S :: "'node SDG_node set"
assumes obs_eq:"obs_intra (parent_node n) ⌊HRB_slice S⌋⇘CFG⇙ =
obs_intra (parent_node n') ⌊HRB_slice S⌋⇘CFG⇙"
shows "rv S n = rv S n'"
proof
show "rv S n ⊆ rv S n'"
proof
fix x assume "x ∈ rv S n"
with obs_eq show "x ∈ rv S n'" by(rule eq_obs_intra_in_rv)
qed
next
show "rv S n' ⊆ rv S n"
proof
fix x assume "x ∈ rv S n'"
with obs_eq[THEN sym] show "x ∈ rv S n" by(rule eq_obs_intra_in_rv)
qed
qed
lemma closed_eq_obs_eq_rvs':
fixes S :: "'node SDG_node set"
assumes obs_eq:"obs_intra m ⌊HRB_slice S⌋⇘CFG⇙ = obs_intra m' ⌊HRB_slice S⌋⇘CFG⇙"
shows "rv S (CFG_node m) = rv S (CFG_node m')"
proof
show "rv S (CFG_node m) ⊆ rv S (CFG_node m')"
proof
fix x assume "x ∈ rv S (CFG_node m)"
with obs_eq show "x ∈ rv S (CFG_node m')"
by -(rule eq_obs_intra_in_rv,auto)
qed
next
show "rv S (CFG_node m') ⊆ rv S (CFG_node m)"
proof
fix x assume "x ∈ rv S (CFG_node m')"
with obs_eq[THEN sym] show "x ∈ rv S (CFG_node m)"
by -(rule eq_obs_intra_in_rv,auto)
qed
qed
lemma rv_branching_edges_slice_kinds_False:
assumes "valid_edge a" and "valid_edge ax"
and "sourcenode a = sourcenode ax" and "targetnode a ≠ targetnode ax"
and "intra_kind (kind a)" and "intra_kind (kind ax)"
and "preds (slice_kinds S (a#as)) s"
and "preds (slice_kinds S (ax#asx)) s'"
and "length s = length s'" and "snd (hd s) = snd (hd s')"
and "∀V∈rv S (CFG_node (sourcenode a)). state_val s V = state_val s' V"
shows False
proof -
from ‹valid_edge a› ‹valid_edge ax› ‹sourcenode a = sourcenode ax›
‹targetnode a ≠ targetnode ax› ‹intra_kind (kind a)› ‹intra_kind (kind ax)›
obtain Q Q' where "kind a = (Q)⇩√" and "kind ax = (Q')⇩√"
and "∀s. (Q s ⟶ ¬ Q' s) ∧ (Q' s ⟶ ¬ Q s)"
by(auto dest:deterministic)
from ‹valid_edge a› ‹valid_edge ax› ‹sourcenode a = sourcenode ax›
‹targetnode a ≠ targetnode ax› ‹intra_kind (kind a)› ‹intra_kind (kind ax)›
obtain P P' where "slice_kind S a = (P)⇩√"
and "slice_kind S ax = (P')⇩√"
and "∀s. (P s ⟶ ¬ P' s) ∧ (P' s ⟶ ¬ P s)"
by -(erule slice_deterministic,auto)
show ?thesis
proof(cases "sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙")
case True
with ‹intra_kind (kind a)›
have "slice_kind S a = kind a" by -(rule slice_intra_kind_in_slice)
with ‹preds (slice_kinds S (a#as)) s› ‹kind a = (Q)⇩√›
‹slice_kind S a = (P)⇩√› have "pred (kind a) s"
by(simp add:slice_kinds_def)
from True ‹sourcenode a = sourcenode ax› ‹intra_kind (kind ax)›
have "slice_kind S ax = kind ax"
by(fastforce intro:slice_intra_kind_in_slice)
with ‹preds (slice_kinds S (ax#asx)) s'› ‹kind ax = (Q')⇩√›
‹slice_kind S ax = (P')⇩√› have "pred (kind ax) s'"
by(simp add:slice_kinds_def)
with ‹kind ax = (Q')⇩√› have "Q' (fst (hd s'))" by(cases s') auto
from ‹valid_edge a› have "sourcenode a -[]→⇩ι* sourcenode a"
by(fastforce intro:empty_path simp:intra_path_def)
with True ‹valid_edge a›
have "∀V ∈ Use (sourcenode a). V ∈ rv S (CFG_node (sourcenode a))"
by(auto intro!:rvI CFG_Use_SDG_Use simp:sourcenodes_def SDG_to_CFG_set_def)
with ‹∀V∈rv S (CFG_node (sourcenode a)). state_val s V = state_val s' V›
have "∀V ∈ Use (sourcenode a). state_val s V = state_val s' V" by blast
with ‹valid_edge a› ‹pred (kind a) s› ‹pred (kind ax) s'› ‹length s = length s'›
‹snd (hd s) = snd (hd s')›
have "pred (kind a) s'" by(auto intro:CFG_edge_Uses_pred_equal)
with ‹kind a = (Q)⇩√› have "Q (fst (hd s'))" by(cases s') auto
with ‹Q' (fst (hd s'))› ‹∀s. (Q s ⟶ ¬ Q' s) ∧ (Q' s ⟶ ¬ Q s)›
have False by simp
thus ?thesis by simp
next
case False
with ‹kind a = (Q)⇩√› ‹slice_kind S a = (P)⇩√› ‹valid_edge a›
have "P = (λs. False) ∨ P = (λs. True)"
by(fastforce elim:kind_Predicate_notin_slice_slice_kind_Predicate)
with ‹slice_kind S a = (P)⇩√›
‹preds (slice_kinds S (a#as)) s›
have "P = (λs. True)" by(cases s)(auto simp:slice_kinds_def)
from ‹sourcenode a = sourcenode ax› False
have "sourcenode ax ∉ ⌊HRB_slice S⌋⇘CFG⇙" by simp
with ‹kind ax = (Q')⇩√› ‹slice_kind S ax = (P')⇩√› ‹valid_edge ax›
have "P' = (λs. False) ∨ P' = (λs. True)"
by(fastforce elim:kind_Predicate_notin_slice_slice_kind_Predicate)
with ‹slice_kind S ax = (P')⇩√›
‹preds (slice_kinds S (ax#asx)) s'›
have "P' = (λs. True)" by(cases s')(auto simp:slice_kinds_def)
with ‹P = (λs. True)› ‹∀s. (P s ⟶ ¬ P' s) ∧ (P' s ⟶ ¬ P s)›
have False by blast
thus ?thesis by simp
qed
qed
lemma rv_edge_slice_kinds:
assumes "valid_edge a" and "intra_kind (kind a)"
and "∀V∈rv S (CFG_node (sourcenode a)). state_val s V = state_val s' V"
and "preds (slice_kinds S (a#as)) s" and "preds (slice_kinds S (a#asx)) s'"
shows "∀V∈rv S (CFG_node (targetnode a)).
state_val (transfer (slice_kind S a) s) V =
state_val (transfer (slice_kind S a) s') V"
proof
fix V assume "V ∈ rv S (CFG_node (targetnode a))"
from ‹preds (slice_kinds S (a#as)) s›
have "s ≠ []" by(cases s,auto simp:slice_kinds_def)
from ‹preds (slice_kinds S (a#asx)) s'›
have "s' ≠ []" by(cases s',auto simp:slice_kinds_def)
show "state_val (transfer (slice_kind S a) s) V =
state_val (transfer (slice_kind S a) s') V"
proof(cases "V ∈ Def (sourcenode a)")
case True
show ?thesis
proof(cases "sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙")
case True
with ‹intra_kind (kind a)› have "slice_kind S a = kind a"
by -(rule slice_intra_kind_in_slice)
with ‹preds (slice_kinds S (a#as)) s› have "pred (kind a) s"
by(simp add:slice_kinds_def)
from ‹slice_kind S a = kind a›
‹preds (slice_kinds S (a#asx)) s'›
have "pred (kind a) s'" by(simp add:slice_kinds_def)
from ‹valid_edge a› have "sourcenode a -[]→⇩ι* sourcenode a"
by(fastforce intro:empty_path simp:intra_path_def)
with True ‹valid_edge a›
have "∀V ∈ Use (sourcenode a). V ∈ rv S (CFG_node (sourcenode a))"
by(auto intro!:rvI CFG_Use_SDG_Use simp:sourcenodes_def SDG_to_CFG_set_def)
with ‹∀V∈rv S (CFG_node (sourcenode a)). state_val s V = state_val s' V›
have "∀V ∈ Use (sourcenode a). state_val s V = state_val s' V" by blast
from ‹valid_edge a› this ‹pred (kind a) s› ‹pred (kind a) s'›
‹intra_kind (kind a)›
have "∀V ∈ Def (sourcenode a).
state_val (transfer (kind a) s) V = state_val (transfer (kind a) s') V"
by -(rule CFG_intra_edge_transfer_uses_only_Use,auto)
with ‹V ∈ Def (sourcenode a)› ‹slice_kind S a = kind a›
show ?thesis by simp
next
case False
from ‹V ∈ rv S (CFG_node (targetnode a))›
obtain xs nx where "targetnode a -xs→⇩ι* parent_node nx"
and "nx ∈ HRB_slice S" and "V ∈ Use⇘SDG⇙ nx"
and "∀n''. valid_SDG_node n'' ∧ parent_node n'' ∈ set (sourcenodes xs)
⟶ V ∉ Def⇘SDG⇙ n''" by(fastforce elim:rvE)
from ‹valid_edge a› have "valid_node (sourcenode a)" by simp
from ‹valid_edge a› ‹targetnode a -xs→⇩ι* parent_node nx› ‹intra_kind (kind a)›
have "sourcenode a -a#xs →⇩ι* parent_node nx"
by(fastforce intro:path.Cons_path simp:intra_path_def)
with ‹V ∈ Def (sourcenode a)› ‹V ∈ Use⇘SDG⇙ nx› ‹valid_node (sourcenode a)›
‹∀n''. valid_SDG_node n'' ∧ parent_node n'' ∈ set (sourcenodes xs)
⟶ V ∉ Def⇘SDG⇙ n''›
have "(CFG_node (sourcenode a)) influences V in nx"
by(fastforce intro:CFG_Def_SDG_Def simp:data_dependence_def)
hence "(CFG_node (sourcenode a)) s-V→⇩d⇩d nx" by(rule sum_SDG_ddep_edge)
from ‹nx ∈ HRB_slice S› ‹(CFG_node (sourcenode a)) s-V→⇩d⇩d nx›
have "CFG_node (sourcenode a) ∈ HRB_slice S"
proof(induct rule:HRB_slice_cases)
case (phase1 n nx')
with ‹(CFG_node (sourcenode a)) s-V→⇩d⇩d nx› show ?case
by(fastforce intro:intro:ddep_slice1 combine_SDG_slices.combSlice_refl
simp:HRB_slice_def)
next
case (phase2 nx' n' n'' p n)
from ‹(CFG_node (sourcenode a)) s-V→⇩d⇩d n› ‹n ∈ sum_SDG_slice2 n'›
have "CFG_node (sourcenode a) ∈ sum_SDG_slice2 n'" by(rule ddep_slice2)
with phase2 show ?thesis
by(fastforce intro:combine_SDG_slices.combSlice_Return_parent_node
simp:HRB_slice_def)
qed
with False have False by(simp add:SDG_to_CFG_set_def)
thus ?thesis by simp
qed
next
case False
from ‹V ∈ rv S (CFG_node (targetnode a))›
obtain xs nx where "targetnode a -xs→⇩ι* parent_node nx"
and "nx ∈ HRB_slice S" and "V ∈ Use⇘SDG⇙ nx"
and all:"∀n''. valid_SDG_node n'' ∧ parent_node n'' ∈ set (sourcenodes xs)
⟶ V ∉ Def⇘SDG⇙ n''" by(fastforce elim:rvE)
from ‹valid_edge a› have "valid_node (sourcenode a)" by simp
from ‹valid_edge a› ‹targetnode a -xs→⇩ι* parent_node nx› ‹intra_kind (kind a)›
have "sourcenode a -a#xs →⇩ι* parent_node nx"
by(fastforce intro:path.Cons_path simp:intra_path_def)
from False all
have "∀n''. valid_SDG_node n'' ∧ parent_node n'' ∈ set (sourcenodes (a#xs))
⟶ V ∉ Def⇘SDG⇙ n''"
by(fastforce dest:SDG_Def_parent_Def simp:sourcenodes_def)
with ‹sourcenode a -a#xs →⇩ι* parent_node nx› ‹nx ∈ HRB_slice S›
‹V ∈ Use⇘SDG⇙ nx›
have "V ∈ rv S (CFG_node (sourcenode a))" by(fastforce intro:rvI)
from ‹intra_kind (kind a)› show ?thesis
proof(cases "kind a")
case(UpdateEdge f)
show ?thesis
proof(cases "sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙")
case True
with ‹intra_kind (kind a)› have "slice_kind S a = kind a"
by(fastforce intro:slice_intra_kind_in_slice)
from UpdateEdge ‹s ≠ []› have "pred (kind a) s" by(cases s) auto
with ‹valid_edge a› ‹V ∉ Def (sourcenode a)› ‹intra_kind (kind a)›
have "state_val (transfer (kind a) s) V = state_val s V"
by(fastforce intro:CFG_intra_edge_no_Def_equal)
from UpdateEdge ‹s' ≠ []› have "pred (kind a) s'" by(cases s') auto
with ‹valid_edge a› ‹V ∉ Def (sourcenode a)› ‹intra_kind (kind a)›
have "state_val (transfer (kind a) s') V = state_val s' V"
by(fastforce intro:CFG_intra_edge_no_Def_equal)
with ‹∀V∈rv S (CFG_node (sourcenode a)). state_val s V = state_val s' V›
‹state_val (transfer (kind a) s) V = state_val s V›
‹V ∈ rv S (CFG_node (sourcenode a))› ‹slice_kind S a = kind a›
show ?thesis by fastforce
next
case False
with UpdateEdge have "slice_kind S a = ⇑id"
by -(rule slice_kind_Upd)
with ‹∀V∈rv S (CFG_node (sourcenode a)). state_val s V = state_val s' V›
‹V ∈ rv S (CFG_node (sourcenode a))› ‹s ≠ []› ‹s' ≠ []›
show ?thesis by(cases s,auto,cases s',auto)
qed
next
case (PredicateEdge Q)
show ?thesis
proof(cases "sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙")
case True
with PredicateEdge ‹intra_kind (kind a)›
have "slice_kind S a = (Q)⇩√"
by(simp add:slice_intra_kind_in_slice)
with ‹∀V∈rv S (CFG_node (sourcenode a)). state_val s V = state_val s' V›
‹V ∈ rv S (CFG_node (sourcenode a))› ‹s ≠ []› ‹s' ≠ []›
show ?thesis by(cases s,auto,cases s',auto)
next
case False
with PredicateEdge ‹valid_edge a›
obtain Q' where "slice_kind S a = (Q')⇩√"
by -(erule kind_Predicate_notin_slice_slice_kind_Predicate)
with‹∀V∈rv S (CFG_node (sourcenode a)). state_val s V = state_val s' V›
‹V ∈ rv S (CFG_node (sourcenode a))› ‹s ≠ []› ‹s' ≠ []›
show ?thesis by(cases s,auto,cases s',auto)
qed
qed (auto simp:intra_kind_def)
qed
qed
subsection ‹The weak simulation relational set ‹WS››
inductive_set WS :: "'node SDG_node set ⇒ (('node list × (('var ⇀ 'val) × 'ret) list) ×
('node list × (('var ⇀ 'val) × 'ret) list)) set"
for S :: "'node SDG_node set"
where WSI: "⟦∀m ∈ set ms. valid_node m; ∀m' ∈ set ms'. valid_node m';
length ms = length s; length ms' = length s'; s ≠ []; s' ≠ []; ms = msx@mx#tl ms';
get_proc mx = get_proc (hd ms');
∀m ∈ set (tl ms'). ∃m'. call_of_return_node m m' ∧ m' ∈ ⌊HRB_slice S⌋⇘CFG⇙;
msx ≠ [] ⟶ (∃mx'. call_of_return_node mx mx' ∧ mx' ∉ ⌊HRB_slice S⌋⇘CFG⇙);
∀i < length ms'. snd (s!(length msx + i)) = snd (s'!i);
∀m ∈ set (tl ms). return_node m;
∀i < length ms'. ∀V ∈ rv S (CFG_node ((mx#tl ms')!i)).
(fst (s!(length msx + i))) V = (fst (s'!i)) V;
obs ms ⌊HRB_slice S⌋⇘CFG⇙ = obs ms' ⌊HRB_slice S⌋⇘CFG⇙⟧
⟹ ((ms,s),(ms',s')) ∈ WS S"
lemma WS_silent_move:
assumes "S,kind ⊢ (ms⇩1,s⇩1) -a→⇩τ (ms⇩1',s⇩1')" and "((ms⇩1,s⇩1),(ms⇩2,s⇩2)) ∈ WS S"
shows "((ms⇩1',s⇩1'),(ms⇩2,s⇩2)) ∈ WS S"
proof -
from ‹((ms⇩1,s⇩1),(ms⇩2,s⇩2)) ∈ WS S› obtain msx mx
where WSE:"∀m ∈ set ms⇩1. valid_node m" "∀m ∈ set ms⇩2. valid_node m"
"length ms⇩1 = length s⇩1" "length ms⇩2 = length s⇩2" "s⇩1 ≠ []" "s⇩2 ≠ []"
"ms⇩1 = msx@mx#tl ms⇩2" "get_proc mx = get_proc (hd ms⇩2)"
"∀m ∈ set (tl ms⇩2). ∃m'. call_of_return_node m m' ∧ m' ∈ ⌊HRB_slice S⌋⇘CFG⇙"
"msx ≠ [] ⟶ (∃mx'. call_of_return_node mx mx' ∧ mx' ∉ ⌊HRB_slice S⌋⇘CFG⇙)"
"∀m ∈ set (tl ms⇩1). return_node m"
"∀i < length ms⇩2. snd (s⇩1!(length msx + i)) = snd (s⇩2!i)"
"∀i < length ms⇩2. ∀V ∈ rv S (CFG_node ((mx#tl ms⇩2)!i)).
(fst (s⇩1!(length msx + i))) V = (fst (s⇩2!i)) V"
"obs ms⇩1 ⌊HRB_slice S⌋⇘CFG⇙ = obs ms⇩2 ⌊HRB_slice S⌋⇘CFG⇙"
by(fastforce elim:WS.cases)
{ assume "∀m ∈ set (tl ms⇩1'). return_node m"
have "obs ms⇩1' ⌊HRB_slice S⌋⇘CFG⇙ = obs ms⇩2 ⌊HRB_slice S⌋⇘CFG⇙"
proof(cases "obs ms⇩1' ⌊HRB_slice S⌋⇘CFG⇙ = {}")
case True
with ‹S,kind ⊢ (ms⇩1,s⇩1) -a→⇩τ (ms⇩1',s⇩1')› have "obs ms⇩1 ⌊HRB_slice S⌋⇘CFG⇙ = {}"
by(rule silent_move_empty_obs_slice)
with ‹obs ms⇩1 ⌊HRB_slice S⌋⇘CFG⇙ = obs ms⇩2 ⌊HRB_slice S⌋⇘CFG⇙›
‹obs ms⇩1' ⌊HRB_slice S⌋⇘CFG⇙ = {}›
show ?thesis by simp
next
case False
from this ‹∀m ∈ set (tl ms⇩1'). return_node m›
obtain ms' where "obs ms⇩1' ⌊HRB_slice S⌋⇘CFG⇙ = {ms'}"
by(fastforce dest:obs_singleton_element)
hence "ms' ∈ obs ms⇩1' ⌊HRB_slice S⌋⇘CFG⇙" by fastforce
from ‹S,kind ⊢ (ms⇩1,s⇩1) -a→⇩τ (ms⇩1',s⇩1')› ‹ms' ∈ obs ms⇩1' ⌊HRB_slice S⌋⇘CFG⇙›
‹∀m ∈ set (tl ms⇩1'). return_node m›
have "ms' ∈ obs ms⇩1 ⌊HRB_slice S⌋⇘CFG⇙" by(fastforce intro:silent_move_obs_slice)
from this ‹∀m ∈ set (tl ms⇩1). return_node m›
have "obs ms⇩1 ⌊HRB_slice S⌋⇘CFG⇙ = {ms'}" by(rule obs_singleton_element)
with ‹obs ms⇩1' ⌊HRB_slice S⌋⇘CFG⇙ = {ms'}›
‹obs ms⇩1 ⌊HRB_slice S⌋⇘CFG⇙ = obs ms⇩2 ⌊HRB_slice S⌋⇘CFG⇙›
show ?thesis by simp
qed }
with ‹S,kind ⊢ (ms⇩1,s⇩1) -a→⇩τ (ms⇩1',s⇩1')› WSE
show ?thesis
proof(induct S f≡"kind" ms⇩1 s⇩1 a ms⇩1' s⇩1' rule:silent_move.induct)
case (silent_move_intra a s⇩1 s⇩1' ms⇩1 S ms⇩1')
note obs_eq = ‹∀a∈set (tl ms⇩1'). return_node a ⟹
obs ms⇩1' ⌊HRB_slice S⌋⇘CFG⇙ = obs ms⇩2 ⌊HRB_slice S⌋⇘CFG⇙›
from ‹s⇩1 ≠ []› ‹s⇩2 ≠ []› obtain cf⇩1 cfs⇩1 cf⇩2 cfs⇩2 where [simp]:"s⇩1 = cf⇩1#cfs⇩1"
and [simp]:"s⇩2 = cf⇩2#cfs⇩2" by(cases s⇩1,auto,cases s⇩2,fastforce+)
from ‹transfer (kind a) s⇩1 = s⇩1'› ‹intra_kind (kind a)›
obtain cf⇩1' where [simp]:"s⇩1' = cf⇩1'#cfs⇩1"
by(cases cf⇩1,cases "kind a",auto simp:intra_kind_def)
from ‹∀m ∈ set ms⇩1. valid_node m› ‹ms⇩1' = targetnode a # tl ms⇩1› ‹valid_edge a›
have "∀m ∈ set ms⇩1'. valid_node m" by(cases ms⇩1) auto
from ‹length ms⇩1 = length s⇩1› ‹length s⇩1' = length s⇩1›
‹ms⇩1' = targetnode a # tl ms⇩1›
have "length ms⇩1' = length s⇩1'" by(cases ms⇩1) auto
from ‹∀m ∈ set (tl ms⇩1). return_node m› ‹ms⇩1' = targetnode a # tl ms⇩1›
have "∀m ∈ set (tl ms⇩1'). return_node m" by simp
from obs_eq[OF this] have "obs ms⇩1' ⌊HRB_slice S⌋⇘CFG⇙ = obs ms⇩2 ⌊HRB_slice S⌋⇘CFG⇙" .
from ‹∀i < length ms⇩2. ∀V ∈ rv S (CFG_node ((mx#tl ms⇩2)!i)).
(fst (s⇩1!(length msx + i))) V = (fst (s⇩2!i)) V› ‹length ms⇩2 = length s⇩2›
have "∀V∈rv S (CFG_node mx). (fst (s⇩1 ! length msx)) V = state_val s⇩2 V"
by(cases ms⇩2) auto
show ?case
proof(cases msx)
case Nil
with ‹ms⇩1 = msx@mx#tl ms⇩2› ‹hd ms⇩1 = sourcenode a›
have [simp]:"mx = sourcenode a" and [simp]:"tl ms⇩1 = tl ms⇩2" by simp_all
from ‹∀m∈set (tl ms⇩2). ∃m'. call_of_return_node m m' ∧ m' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
‹(∃m∈set (tl ms⇩1). ∃m'. call_of_return_node m m' ∧ m' ∉ ⌊HRB_slice S⌋⇘CFG⇙) ∨
hd ms⇩1 ∉ ⌊HRB_slice S⌋⇘CFG⇙›
have "hd ms⇩1 ∉ ⌊HRB_slice S⌋⇘CFG⇙" by fastforce
with ‹hd ms⇩1 = sourcenode a› have "sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙" by simp
from ‹ms⇩1' = targetnode a # tl ms⇩1› have "ms⇩1' = [] @ targetnode a # tl ms⇩2"
by simp
from ‹valid_edge a› ‹intra_kind(kind a)›
have "get_proc (sourcenode a) = get_proc (targetnode a)" by(rule get_proc_intra)
with ‹get_proc mx = get_proc (hd ms⇩2)›
have "get_proc (targetnode a) = get_proc (hd ms⇩2)" by simp
from ‹transfer (kind a) s⇩1 = s⇩1'› ‹intra_kind (kind a)›
have "snd cf⇩1' = snd cf⇩1" by(auto simp:intra_kind_def)
with ‹∀i<length ms⇩2. snd (s⇩1 ! (length msx + i)) = snd (s⇩2 ! i)› Nil
have "∀i<length ms⇩2. snd (s⇩1' ! i) = snd (s⇩2 ! i)"
by auto(case_tac i,auto)
have "∀V ∈ rv S (CFG_node (targetnode a)). fst cf⇩1' V = fst cf⇩2 V"
proof
fix V assume "V ∈ rv S (CFG_node (targetnode a))"
from ‹valid_edge a› ‹intra_kind (kind a)› ‹sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙›
have "obs_intra (targetnode a) ⌊HRB_slice S⌋⇘CFG⇙ =
obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙"
by(rule edge_obs_intra_slice_eq)
hence "rv S (CFG_node (targetnode a)) = rv S (CFG_node (sourcenode a))"
by(rule closed_eq_obs_eq_rvs')
with ‹V ∈ rv S (CFG_node (targetnode a))›
have "V ∈ rv S (CFG_node (sourcenode a))" by simp
then obtain as n' where "sourcenode a -as→⇩ι* parent_node n'"
and "n' ∈ HRB_slice S" and "V ∈ Use⇘SDG⇙ n'"
and "∀n''. valid_SDG_node n'' ∧ parent_node n'' ∈ set (sourcenodes as)
⟶ V ∉ Def⇘SDG⇙ n''"
by(fastforce elim:rvE)
with ‹sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙› ‹valid_edge a›
have "V ∉ Def⇘SDG⇙ (CFG_node (sourcenode a))"
apply(clarsimp simp:intra_path_def)
apply(erule path.cases)
by(auto dest:valid_SDG_node_in_slice_parent_node_in_slice
simp:sourcenodes_def SDG_to_CFG_set_def)
from ‹valid_edge a› have "valid_node (sourcenode a)" by simp
with ‹V ∉ Def⇘SDG⇙ (CFG_node (sourcenode a))› have "V ∉ Def (sourcenode a)"
by(fastforce intro:CFG_Def_SDG_Def valid_SDG_CFG_node)
with ‹valid_edge a› ‹intra_kind (kind a)› ‹pred (kind a) s⇩1›
have "state_val (transfer (kind a) s⇩1) V = state_val s⇩1 V"
by(fastforce intro:CFG_intra_edge_no_Def_equal)
with ‹transfer (kind a) s⇩1 = s⇩1'› have "fst cf⇩1' V = fst cf⇩1 V" by simp
from ‹V ∈ rv S (CFG_node (sourcenode a))› ‹msx = []›
‹∀V∈rv S (CFG_node mx). (fst (s⇩1 ! length msx)) V = state_val s⇩2 V›
have "fst cf⇩1 V = fst cf⇩2 V" by simp
with ‹fst cf⇩1' V = fst cf⇩1 V› show "fst cf⇩1' V = fst cf⇩2 V" by simp
qed
with ‹∀i<length ms⇩2. ∀V∈rv S (CFG_node ((mx # tl ms⇩2) ! i)).
(fst (s⇩1 ! (length msx + i))) V = (fst (s⇩2 ! i)) V› Nil
have "∀i<length ms⇩2. ∀V∈rv S (CFG_node ((targetnode a # tl ms⇩2) ! i)).
(fst (s⇩1' ! (length [] + i))) V = (fst (s⇩2 ! i)) V"
by auto (case_tac i,auto)
with ‹∀m ∈ set ms⇩1'. valid_node m› ‹∀m ∈ set ms⇩2. valid_node m›
‹length ms⇩1' = length s⇩1'› ‹length ms⇩2 = length s⇩2›
‹ms⇩1' = [] @ targetnode a # tl ms⇩2›
‹get_proc (targetnode a) = get_proc (hd ms⇩2)›
‹∀m ∈ set (tl ms⇩2). ∃m'. call_of_return_node m m' ∧ m' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
‹∀m ∈ set (tl ms⇩1). return_node m›
‹obs ms⇩1' ⌊HRB_slice S⌋⇘CFG⇙ = obs ms⇩2 ⌊HRB_slice S⌋⇘CFG⇙›
‹∀i<length ms⇩2. snd (s⇩1' ! i) = snd (s⇩2 ! i)›
show ?thesis by(auto intro!:WSI)
next
case (Cons mx' msx')
with ‹ms⇩1 = msx@mx#tl ms⇩2› ‹hd ms⇩1 = sourcenode a›
have [simp]:"mx' = sourcenode a" and [simp]:"tl ms⇩1 = msx'@mx#tl ms⇩2"
by simp_all
from ‹ms⇩1' = targetnode a # tl ms⇩1› have "ms⇩1' = ((targetnode a)#msx')@mx#tl ms⇩2"
by simp
from ‹∀V∈rv S (CFG_node mx). (fst (s⇩1 ! length msx)) V = state_val s⇩2 V› Cons
have rv:"∀V∈rv S (CFG_node mx).
(fst (s⇩1' ! length (targetnode a#msx'))) V = state_val s⇩2 V" by fastforce
from ‹ms⇩1 = msx@mx#tl ms⇩2› Cons ‹ms⇩1' = targetnode a # tl ms⇩1›
have "ms⇩1' = ((targetnode a)#msx')@mx#tl ms⇩2" by simp
from ‹∀i<length ms⇩2. snd (s⇩1 ! (length msx + i)) = snd (s⇩2 ! i)› Cons
have "∀i<length ms⇩2. snd (s⇩1' ! (length msx + i)) = snd (s⇩2 ! i)" by fastforce
from ‹∀V∈rv S (CFG_node mx). (fst (s⇩1 ! length msx)) V = state_val s⇩2 V› Cons
have "∀V∈rv S (CFG_node mx). (fst (s⇩1' ! length msx)) V = state_val s⇩2 V"
by simp
with ‹∀i < length ms⇩2. ∀V ∈ rv S (CFG_node ((mx#tl ms⇩2)!i)).
(fst (s⇩1!(length msx + i))) V = (fst (s⇩2!i)) V› Cons
have "∀i<length ms⇩2. ∀V∈rv S (CFG_node ((mx # tl ms⇩2)!i)).
(fst (s⇩1'!(length (targetnode a # msx') + i))) V = (fst (s⇩2!i)) V"
by clarsimp
with ‹∀m∈set ms⇩1'. valid_node m› ‹∀m∈set ms⇩2. valid_node m›
‹length ms⇩1' = length s⇩1'› ‹length ms⇩2 = length s⇩2›
‹ms⇩1' = ((targetnode a)#msx')@mx#tl ms⇩2›
‹∀m∈set (tl ms⇩2). ∃m'. call_of_return_node m m' ∧ m' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
‹∀m ∈ set (tl ms⇩1'). return_node m› ‹get_proc mx = get_proc (hd ms⇩2)›
‹msx ≠ [] ⟶ (∃mx'. call_of_return_node mx mx' ∧ mx' ∉ ⌊HRB_slice S⌋⇘CFG⇙)›
‹obs ms⇩1' ⌊HRB_slice S⌋⇘CFG⇙ = obs ms⇩2 ⌊HRB_slice S⌋⇘CFG⇙› Cons
‹∀i<length ms⇩2. snd (s⇩1' ! (length msx + i)) = snd (s⇩2 ! i)›
show ?thesis by -(rule WSI,clarsimp+,fastforce,clarsimp+)
qed
next
case (silent_move_call a s⇩1 s⇩1' Q r p fs a' ms⇩1 S ms⇩1')
note obs_eq = ‹∀a∈set (tl ms⇩1'). return_node a ⟹
obs ms⇩1' ⌊HRB_slice S⌋⇘CFG⇙ = obs ms⇩2 ⌊HRB_slice S⌋⇘CFG⇙›
from ‹s⇩1 ≠ []› ‹s⇩2 ≠ []› obtain cf⇩1 cfs⇩1 cf⇩2 cfs⇩2 where [simp]:"s⇩1 = cf⇩1#cfs⇩1"
and [simp]:"s⇩2 = cf⇩2#cfs⇩2" by(cases s⇩1,auto,cases s⇩2,fastforce+)
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs›
obtain ins outs where "(p,ins,outs) ∈ set procs"
by(fastforce dest!:callee_in_procs)
with ‹transfer (kind a) s⇩1 = s⇩1'› ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs›
have [simp]:"s⇩1' = (Map.empty(ins [:=] params fs (fst cf⇩1)), r) # cf⇩1 # cfs⇩1"
by simp(unfold formal_in_THE,simp)
from ‹length ms⇩1 = length s⇩1› ‹ms⇩1' = targetnode a # targetnode a' # tl ms⇩1›
have "length ms⇩1' = length s⇩1'" by simp
from ‹valid_edge a› ‹a' ∈ get_return_edges a› have "valid_edge a'"
by(rule get_return_edges_valid)
with ‹∀m∈set ms⇩1. valid_node m› ‹valid_edge a›
‹ms⇩1' = targetnode a # targetnode a' # tl ms⇩1›
have "∀m∈set ms⇩1'. valid_node m" by(cases ms⇩1) auto
from ‹valid_edge a'› ‹valid_edge a› ‹a' ∈ get_return_edges a›
have "return_node (targetnode a')" by(fastforce simp:return_node_def)
with ‹valid_edge a› ‹a' ∈ get_return_edges a› ‹valid_edge a'›
have "call_of_return_node (targetnode a') (sourcenode a)"
by(simp add:call_of_return_node_def) blast
from ‹∀m ∈ set (tl ms⇩1). return_node m› ‹return_node (targetnode a')›
‹ms⇩1' = targetnode a # targetnode a' # tl ms⇩1›
have "∀m ∈ set (tl ms⇩1'). return_node m" by simp
from obs_eq[OF this] have "obs ms⇩1' ⌊HRB_slice S⌋⇘CFG⇙ = obs ms⇩2 ⌊HRB_slice S⌋⇘CFG⇙" .
from ‹∀i < length ms⇩2. ∀V ∈ rv S (CFG_node ((mx#tl ms⇩2)!i)).
(fst (s⇩1!(length msx + i))) V = (fst (s⇩2!i)) V› ‹length ms⇩2 = length s⇩2›
have "∀V∈rv S (CFG_node mx). (fst (s⇩1 ! length msx)) V = state_val s⇩2 V"
by(erule_tac x="0" in allE) auto
show ?case
proof(cases msx)
case Nil
with ‹ms⇩1 = msx@mx#tl ms⇩2› ‹hd ms⇩1 = sourcenode a›
have [simp]:"mx = sourcenode a" and [simp]:"tl ms⇩1 = tl ms⇩2" by simp_all
from ‹∀m∈set (tl ms⇩2). ∃m'. call_of_return_node m m' ∧ m' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
‹(∃m∈set (tl ms⇩1). ∃m'. call_of_return_node m m' ∧ m' ∉ ⌊HRB_slice S⌋⇘CFG⇙) ∨
hd ms⇩1 ∉ ⌊HRB_slice S⌋⇘CFG⇙›
have "hd ms⇩1 ∉ ⌊HRB_slice S⌋⇘CFG⇙" by fastforce
with ‹hd ms⇩1 = sourcenode a› have "sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙" by simp
from ‹valid_edge a› ‹a' ∈ get_return_edges a›
obtain a'' where "valid_edge a''" and "sourcenode a'' = sourcenode a"
and "targetnode a'' = targetnode a'" and "intra_kind(kind a'')"
by -(drule call_return_node_edge,auto simp:intra_kind_def)
from ‹valid_edge a''› ‹intra_kind(kind a'')›
have "get_proc (sourcenode a'') = get_proc (targetnode a'')"
by(rule get_proc_intra)
with ‹sourcenode a'' = sourcenode a› ‹targetnode a'' = targetnode a'›
‹get_proc mx = get_proc (hd ms⇩2)›
have "get_proc (targetnode a') = get_proc (hd ms⇩2)" by simp
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹a' ∈ get_return_edges a›
have "CFG_node (sourcenode a) s-p→⇘sum⇙ CFG_node (targetnode a')"
by(fastforce intro:sum_SDG_call_summary_edge)
have "targetnode a' ∉ ⌊HRB_slice S⌋⇘CFG⇙"
proof
assume "targetnode a' ∈ ⌊HRB_slice S⌋⇘CFG⇙"
hence "CFG_node (targetnode a') ∈ HRB_slice S" by(simp add:SDG_to_CFG_set_def)
hence "CFG_node (sourcenode a) ∈ HRB_slice S"
proof(induct "CFG_node (targetnode a')" rule:HRB_slice_cases)
case (phase1 nx)
with ‹CFG_node (sourcenode a) s-p→⇘sum⇙ CFG_node (targetnode a')›
show ?case by(fastforce intro:combine_SDG_slices.combSlice_refl sum_slice1
simp:HRB_slice_def)
next
case (phase2 nx n' n'' p')
from ‹CFG_node (targetnode a') ∈ sum_SDG_slice2 n'›
‹CFG_node (sourcenode a) s-p→⇘sum⇙ CFG_node (targetnode a')› ‹valid_edge a›
have "CFG_node (sourcenode a) ∈ sum_SDG_slice2 n'"
by(fastforce intro:sum_slice2)
with ‹n' ∈ sum_SDG_slice1 nx› ‹n'' s-p'→⇘ret⇙ CFG_node (parent_node n')›
‹nx ∈ S›
show ?case
by(fastforce intro:combine_SDG_slices.combSlice_Return_parent_node
simp:HRB_slice_def)
qed
with ‹sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙› show False
by(simp add:SDG_to_CFG_set_def HRB_slice_def)
qed
from ‹ms⇩1' = targetnode a # targetnode a' # tl ms⇩1›
have "ms⇩1' = [targetnode a] @ targetnode a' # tl ms⇩2" by simp
from ‹∀i<length ms⇩2. snd (s⇩1 ! (length msx + i)) = snd (s⇩2 ! i)› Nil
have "∀i<length ms⇩2. snd (s⇩1' ! (length [targetnode a] + i)) = snd (s⇩2 ! i)"
by fastforce
have "∀V∈rv S (CFG_node (targetnode a')). (fst (s⇩1' ! 1)) V = state_val s⇩2 V"
proof
fix V assume "V ∈ rv S (CFG_node (targetnode a'))"
from ‹valid_edge a› ‹a' ∈ get_return_edges a›
obtain a'' where edge:"valid_edge a''" "sourcenode a'' = sourcenode a"
"targetnode a'' = targetnode a'" "intra_kind(kind a'')"
by -(drule call_return_node_edge,auto simp:intra_kind_def)
from ‹V ∈ rv S (CFG_node (targetnode a'))›
obtain as n' where "targetnode a' -as→⇩ι* parent_node n'"
and "n' ∈ HRB_slice S" and "V ∈ Use⇘SDG⇙ n'"
and "∀n''. valid_SDG_node n'' ∧ parent_node n'' ∈ set (sourcenodes as)
⟶ V ∉ Def⇘SDG⇙ n''"
by(fastforce elim:rvE)
from ‹targetnode a' -as→⇩ι* parent_node n'› edge
have "sourcenode a -a''#as→⇩ι* parent_node n'"
by(fastforce intro:Cons_path simp:intra_path_def)
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs›
have "V ∉ Def (sourcenode a)"
by(fastforce dest:call_source_Def_empty)
with ‹∀n''. valid_SDG_node n'' ∧ parent_node n'' ∈ set (sourcenodes as)
⟶ V ∉ Def⇘SDG⇙ n''› ‹sourcenode a'' = sourcenode a›
have "∀n''. valid_SDG_node n'' ∧ parent_node n'' ∈ set (sourcenodes (a''#as))
⟶ V ∉ Def⇘SDG⇙ n''"
by(fastforce dest:SDG_Def_parent_Def simp:sourcenodes_def)
with ‹sourcenode a -a''#as→⇩ι* parent_node n'› ‹n' ∈ HRB_slice S›
‹V ∈ Use⇘SDG⇙ n'›
have "V ∈ rv S (CFG_node (sourcenode a))" by(fastforce intro:rvI)
from ‹∀V∈rv S (CFG_node mx). (fst (s⇩1 ! length msx)) V = state_val s⇩2 V› Nil
have "∀V∈rv S (CFG_node (sourcenode a)). fst cf⇩1 V = fst cf⇩2 V" by simp
with ‹V ∈ rv S (CFG_node (sourcenode a))› have "fst cf⇩1 V = fst cf⇩2 V" by simp
thus "(fst (s⇩1' ! 1)) V = state_val s⇩2 V" by simp
qed
with ‹∀i < length ms⇩2. ∀V ∈ rv S (CFG_node ((mx#tl ms⇩2)!i)).
(fst (s⇩1!(length msx + i))) V = (fst (s⇩2!i)) V› Nil
have "∀i<length ms⇩2. ∀V∈rv S (CFG_node ((targetnode a' # tl ms⇩2)!i)).
(fst (s⇩1'!(length [targetnode a] + i))) V = (fst (s⇩2!i)) V"
by clarsimp(case_tac i,auto)
with ‹∀m∈set ms⇩1'. valid_node m› ‹∀m∈set ms⇩2. valid_node m›
‹length ms⇩1' = length s⇩1'› ‹length ms⇩2 = length s⇩2›
‹∀m∈set (tl ms⇩2). ∃m'. call_of_return_node m m' ∧ m' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
‹ms⇩1' = [targetnode a] @ targetnode a' # tl ms⇩2›
‹targetnode a' ∉ ⌊HRB_slice S⌋⇘CFG⇙› ‹return_node (targetnode a')›
‹obs ms⇩1' ⌊HRB_slice S⌋⇘CFG⇙ = obs ms⇩2 ⌊HRB_slice S⌋⇘CFG⇙›
‹get_proc (targetnode a') = get_proc (hd ms⇩2)›
‹∀m ∈ set (tl ms⇩1'). return_node m› ‹sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙›
‹call_of_return_node (targetnode a') (sourcenode a)›
‹∀i<length ms⇩2. snd (s⇩1' ! (length [targetnode a] + i)) = snd (s⇩2 ! i)›
show ?thesis by(auto intro!:WSI)
next
case (Cons mx' msx')
with ‹ms⇩1 = msx@mx#tl ms⇩2› ‹hd ms⇩1 = sourcenode a›
have [simp]:"mx' = sourcenode a" and [simp]:"tl ms⇩1 = msx'@mx#tl ms⇩2"
by simp_all
from ‹ms⇩1' = targetnode a # targetnode a' # tl ms⇩1›
have "ms⇩1' = (targetnode a # targetnode a' # msx')@mx#tl ms⇩2"
by simp
from ‹∀i<length ms⇩2. snd (s⇩1 ! (length msx + i)) = snd (s⇩2 ! i)› Cons
have "∀i<length ms⇩2.
snd (s⇩1' ! (length (targetnode a # targetnode a' # msx') + i)) = snd (s⇩2 ! i)"
by fastforce
from ‹∀V∈rv S (CFG_node mx). (fst (s⇩1 ! length msx)) V = state_val s⇩2 V› Cons
have "∀V∈rv S (CFG_node mx).
(fst (s⇩1' ! length(targetnode a # targetnode a' # msx'))) V = state_val s⇩2 V"
by simp
with ‹∀i < length ms⇩2. ∀V ∈ rv S (CFG_node ((mx#tl ms⇩2)!i)).
(fst (s⇩1!(length msx + i))) V = (fst (s⇩2!i)) V› Cons
have "∀i<length ms⇩2. ∀V∈rv S (CFG_node ((mx # tl ms⇩2)!i)).
(fst (s⇩1'!(length (targetnode a # targetnode a' # msx') + i))) V =
(fst (s⇩2!i)) V"
by clarsimp
with ‹∀m∈set ms⇩1'. valid_node m› ‹∀m∈set ms⇩2. valid_node m›
‹length ms⇩1' = length s⇩1'› ‹length ms⇩2 = length s⇩2›
‹ms⇩1' = (targetnode a # targetnode a' # msx')@mx#tl ms⇩2›
‹return_node (targetnode a')›
‹∀m∈set (tl ms⇩2). ∃m'. call_of_return_node m m' ∧ m' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
‹msx ≠ [] ⟶ (∃mx'. call_of_return_node mx mx' ∧ mx' ∉ ⌊HRB_slice S⌋⇘CFG⇙)›
‹obs ms⇩1' ⌊HRB_slice S⌋⇘CFG⇙ = obs ms⇩2 ⌊HRB_slice S⌋⇘CFG⇙› Cons
‹get_proc mx = get_proc (hd ms⇩2)› ‹∀m ∈ set (tl ms⇩1'). return_node m›
‹∀i<length ms⇩2.
snd (s⇩1' ! (length (targetnode a # targetnode a' # msx') + i)) = snd (s⇩2 ! i)›
show ?thesis by -(rule WSI,clarsimp+,fastforce,clarsimp+)
qed
next
case (silent_move_return a s⇩1 s⇩1' Q p f' ms⇩1 S ms⇩1')
note obs_eq = ‹∀a∈set (tl ms⇩1'). return_node a ⟹
obs ms⇩1' ⌊HRB_slice S⌋⇘CFG⇙ = obs ms⇩2 ⌊HRB_slice S⌋⇘CFG⇙›
from ‹transfer (kind a) s⇩1 = s⇩1'› ‹kind a = Q↩⇘p⇙f'› ‹s⇩1 ≠ []› ‹s⇩1' ≠ []›
obtain cf⇩1 cfx⇩1 cfs⇩1 cf⇩1' where [simp]:"s⇩1 = cf⇩1#cfx⇩1#cfs⇩1"
and "s⇩1' = (f' (fst cf⇩1) (fst cfx⇩1),snd cfx⇩1)#cfs⇩1"
by(cases s⇩1,auto,case_tac list,fastforce+)
from ‹s⇩2 ≠ []› obtain cf⇩2 cfs⇩2 where [simp]:"s⇩2 = cf⇩2#cfs⇩2" by(cases s⇩2) auto
from ‹length ms⇩1 = length s⇩1› have "ms⇩1 ≠ []" and "tl ms⇩1 ≠ []" by(cases ms⇩1,auto)+
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f'›
obtain a' Q' r' fs' where "valid_edge a'" and "kind a' = Q':r'↪⇘p⇙fs'"
and "a ∈ get_return_edges a'"
by -(drule return_needs_call,auto)
then obtain ins outs where "(p,ins,outs) ∈ set procs"
by(fastforce dest!:callee_in_procs)
with ‹valid_edge a› ‹kind a = Q↩⇘p⇙f'›
have "f' (fst cf⇩1) (fst cfx⇩1) =
(fst cfx⇩1)(ParamDefs (targetnode a) [:=] map (fst cf⇩1) outs)"
by(rule CFG_return_edge_fun)
with ‹s⇩1' = (f' (fst cf⇩1) (fst cfx⇩1),snd cfx⇩1)#cfs⇩1›
have [simp]:"s⇩1' = ((fst cfx⇩1)
(ParamDefs (targetnode a) [:=] map (fst cf⇩1) outs),snd cfx⇩1)#cfs⇩1" by simp
from ‹∀m∈set ms⇩1. valid_node m› ‹ms⇩1' = tl ms⇩1› have "∀m∈set ms⇩1'. valid_node m"
by(cases ms⇩1) auto
from ‹length ms⇩1 = length s⇩1› ‹ms⇩1' = tl ms⇩1›
have "length ms⇩1' = length s⇩1'" by simp
from ‹∀m∈set (tl ms⇩1). return_node m› ‹ms⇩1' = tl ms⇩1› ‹ms⇩1 ≠ []› ‹tl ms⇩1 ≠ []›
have "∀m∈set (tl ms⇩1'). return_node m" by(cases ms⇩1)(auto,cases ms⇩1',auto)
from obs_eq[OF this] have "obs ms⇩1' ⌊HRB_slice S⌋⇘CFG⇙ = obs ms⇩2 ⌊HRB_slice S⌋⇘CFG⇙" .
show ?case
proof(cases msx)
case Nil
with ‹ms⇩1 = msx@mx#tl ms⇩2› ‹hd ms⇩1 = sourcenode a›
have "mx = sourcenode a" and "tl ms⇩1 = tl ms⇩2" by simp_all
with ‹∃m∈set (tl ms⇩1). ∃m'. call_of_return_node m m' ∧ m' ∉ ⌊HRB_slice S⌋⇘CFG⇙›
‹∀m∈set (tl ms⇩2). ∃m'. call_of_return_node m m' ∧ m' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
have False by fastforce
thus ?thesis by simp
next
case (Cons mx' msx')
with ‹ms⇩1 = msx@mx#tl ms⇩2› ‹hd ms⇩1 = sourcenode a›
have [simp]:"mx' = sourcenode a" and [simp]:"tl ms⇩1 = msx'@mx#tl ms⇩2"
by simp_all
from ‹ms⇩1' = tl ms⇩1› have "ms⇩1' = msx'@mx#tl ms⇩2" by simp
with ‹ms⇩1 = msx@mx#tl ms⇩2› ‹∀m∈set (tl ms⇩1). return_node m› Cons
have "∀m∈set (tl ms⇩1'). return_node m"
by(cases msx') auto
from ‹∀i<length ms⇩2. snd (s⇩1 ! (length msx + i)) = snd (s⇩2 ! i)› Cons
have "∀i<length ms⇩2. snd (s⇩1' ! (length msx' + i)) = snd (s⇩2 ! i)"
by auto(case_tac i,auto,cases msx',auto)
from ‹∀i<length ms⇩2. ∀V∈rv S (CFG_node ((mx # tl ms⇩2) ! i)).
(fst (s⇩1 ! (length msx + i))) V = (fst (s⇩2 ! i)) V›
‹length ms⇩2 = length s⇩2› ‹s⇩2 ≠ []›
have "∀V∈rv S (CFG_node mx). (fst (s⇩1 ! length msx)) V = state_val s⇩2 V"
by fastforce
have "∀V∈rv S (CFG_node mx). (fst (s⇩1' ! length msx')) V = state_val s⇩2 V"
proof(cases msx')
case Nil
with ‹∀V∈rv S (CFG_node mx). (fst (s⇩1 ! length msx)) V = state_val s⇩2 V›
‹msx = mx'#msx'›
have rv:"∀V∈rv S (CFG_node mx). fst cfx⇩1 V = fst cf⇩2 V" by fastforce
from Nil ‹tl ms⇩1 = msx'@mx#tl ms⇩2› ‹hd (tl ms⇩1) = targetnode a›
have [simp]:"mx = targetnode a" by simp
from Cons
‹msx ≠ [] ⟶ (∃mx'. call_of_return_node mx mx' ∧ mx' ∉ ⌊HRB_slice S⌋⇘CFG⇙)›
obtain mx'' where "call_of_return_node mx mx''" and "mx'' ∉ ⌊HRB_slice S⌋⇘CFG⇙"
by blast
hence "mx ∉ ⌊HRB_slice S⌋⇘CFG⇙"
by(rule call_node_notin_slice_return_node_neither)
have "∀V∈rv S (CFG_node mx).
(fst cfx⇩1)(ParamDefs (targetnode a) [:=] map (fst cf⇩1) outs) V = fst cf⇩2 V"
proof
fix V assume "V∈rv S (CFG_node mx)"
show "(fst cfx⇩1)(ParamDefs (targetnode a) [:=] map (fst cf⇩1) outs) V =
fst cf⇩2 V"
proof(cases "V ∈ set (ParamDefs (targetnode a))")
case True
with ‹valid_edge a› have "V ∈ Def (targetnode a)"
by(fastforce intro:ParamDefs_in_Def)
with ‹valid_edge a› have "V ∈ Def⇘SDG⇙ (CFG_node (targetnode a))"
by(auto intro!:CFG_Def_SDG_Def)
from ‹V∈rv S (CFG_node mx)› obtain as n'
where "targetnode a -as→⇩ι* parent_node n'"
and "n' ∈ HRB_slice S" "V ∈ Use⇘SDG⇙ n'"
and "∀n''. valid_SDG_node n'' ∧ parent_node n'' ∈ set (sourcenodes as)
⟶ V ∉ Def⇘SDG⇙ n''" by(fastforce elim:rvE)
from ‹targetnode a -as→⇩ι* parent_node n'› ‹n' ∈ HRB_slice S›
‹mx ∉ ⌊HRB_slice S⌋⇘CFG⇙›
obtain ax asx where "as = ax#asx"
by(auto simp:intra_path_def)(erule path.cases,
auto dest:valid_SDG_node_in_slice_parent_node_in_slice
simp:SDG_to_CFG_set_def)
with ‹targetnode a -as→⇩ι* parent_node n'›
have "targetnode a = sourcenode ax" and "valid_edge ax"
by(auto elim:path.cases simp:intra_path_def)
with ‹∀n''. valid_SDG_node n'' ∧ parent_node n'' ∈ set (sourcenodes as)
⟶ V ∉ Def⇘SDG⇙ n''› ‹as = ax#asx› ‹V ∈ Def⇘SDG⇙ (CFG_node (targetnode a))›
have False by(fastforce simp:sourcenodes_def)
thus ?thesis by simp
next
case False
with ‹V∈rv S (CFG_node mx)› rv show ?thesis
by(fastforce dest:fun_upds_notin[of _ _ "fst cfx⇩1"])
qed
qed
with Nil ‹msx = mx'#msx'› show ?thesis by fastforce
next
case Cons
with ‹∀V∈rv S (CFG_node mx). (fst (s⇩1 ! length msx)) V = state_val s⇩2 V›
‹msx = mx'#msx'›
show ?thesis by fastforce
qed
with ‹∀V∈rv S (CFG_node mx). (fst (s⇩1 ! length msx)) V = state_val s⇩2 V› Cons
have "∀V∈rv S (CFG_node mx). (fst (s⇩1' ! length msx')) V = state_val s⇩2 V"
by(cases msx') auto
with ‹∀i < length ms⇩2. ∀V ∈ rv S (CFG_node ((mx#tl ms⇩2)!i)).
(fst (s⇩1!(length msx + i))) V = (fst (s⇩2!i)) V› Cons
have "∀i<length ms⇩2. ∀V∈rv S (CFG_node ((mx # tl ms⇩2) ! i)).
(fst (s⇩1' ! (length msx' + i))) V = (fst (s⇩2 ! i)) V"
by clarsimp(case_tac i,auto)
with ‹∀m∈set ms⇩1'. valid_node m› ‹∀m∈set ms⇩2. valid_node m›
‹length ms⇩1' = length s⇩1'› ‹length ms⇩2 = length s⇩2›
‹ms⇩1' = msx'@mx#tl ms⇩2› ‹get_proc mx = get_proc (hd ms⇩2)›
‹∀m∈set (tl ms⇩2). ∃m'. call_of_return_node m m' ∧ m' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
‹msx ≠ [] ⟶ (∃mx'. call_of_return_node mx mx' ∧ mx' ∉ ⌊HRB_slice S⌋⇘CFG⇙)›
‹∀m∈set (tl ms⇩1'). return_node m› Cons ‹get_proc mx = get_proc (hd ms⇩2)›
‹∀m∈set (tl ms⇩2). ∃m'. call_of_return_node m m' ∧ m' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
‹obs ms⇩1' ⌊HRB_slice S⌋⇘CFG⇙ = obs ms⇩2 ⌊HRB_slice S⌋⇘CFG⇙›
‹∀i<length ms⇩2. snd (s⇩1' ! (length msx' + i)) = snd (s⇩2 ! i)›
show ?thesis by(auto intro!:WSI)
qed
qed
qed
lemma WS_silent_moves:
"⟦S,kind ⊢ (ms⇩1,s⇩1) =as⇒⇩τ (ms⇩1',s⇩1'); ((ms⇩1,s⇩1),(ms⇩2,s⇩2)) ∈ WS S⟧
⟹ ((ms⇩1',s⇩1'),(ms⇩2,s⇩2)) ∈ WS S"
by(induct S f≡"kind" ms⇩1 s⇩1 as ms⇩1' s⇩1' rule:silent_moves.induct,
auto dest:WS_silent_move)
lemma WS_observable_move:
assumes "((ms⇩1,s⇩1),(ms⇩2,s⇩2)) ∈ WS S"
and "S,kind ⊢ (ms⇩1,s⇩1) -a→ (ms⇩1',s⇩1')" and "s⇩1' ≠ []"
obtains as where "((ms⇩1',s⇩1'),(ms⇩1',transfer (slice_kind S a) s⇩2)) ∈ WS S"
and "S,slice_kind S ⊢ (ms⇩2,s⇩2) =as@[a]⇒ (ms⇩1',transfer (slice_kind S a) s⇩2)"
proof(atomize_elim)
from ‹((ms⇩1,s⇩1),(ms⇩2,s⇩2)) ∈ WS S› obtain msx mx
where assms:"∀m ∈ set ms⇩1. valid_node m" "∀m ∈ set ms⇩2. valid_node m"
"length ms⇩1 = length s⇩1" "length ms⇩2 = length s⇩2" "s⇩1 ≠ []" "s⇩2 ≠ []"
"ms⇩1 = msx@mx#tl ms⇩2" "get_proc mx = get_proc (hd ms⇩2)"
"∀m ∈ set (tl ms⇩2). ∃m'. call_of_return_node m m' ∧ m' ∈ ⌊HRB_slice S⌋⇘CFG⇙"
"msx ≠ [] ⟶ (∃mx'. call_of_return_node mx mx' ∧ mx' ∉ ⌊HRB_slice S⌋⇘CFG⇙)"
"∀m ∈ set (tl ms⇩1). return_node m"
"∀i < length ms⇩2. snd (s⇩1!(length msx + i)) = snd (s⇩2!i)"
"∀i < length ms⇩2. ∀V ∈ rv S (CFG_node ((mx#tl ms⇩2)!i)).
(fst (s⇩1!(length msx + i))) V = (fst (s⇩2!i)) V"
"obs ms⇩1 ⌊HRB_slice S⌋⇘CFG⇙ = obs ms⇩2 ⌊HRB_slice S⌋⇘CFG⇙"
by(fastforce elim:WS.cases)
from ‹S,kind ⊢ (ms⇩1,s⇩1) -a→ (ms⇩1',s⇩1')› assms
show "∃as. ((ms⇩1',s⇩1'),(ms⇩1',transfer (slice_kind S a) s⇩2)) ∈ WS S ∧
S,slice_kind S ⊢ (ms⇩2,s⇩2) =as @ [a]⇒ (ms⇩1',transfer (slice_kind S a) s⇩2)"
proof(induct S f≡"kind" ms⇩1 s⇩1 a ms⇩1' s⇩1' rule:observable_move.induct)
case (observable_move_intra a s⇩1 s⇩1' ms⇩1 S ms⇩1')
from ‹s⇩1 ≠ []› ‹s⇩2 ≠ []› obtain cf⇩1 cfs⇩1 cf⇩2 cfs⇩2 where [simp]:"s⇩1 = cf⇩1#cfs⇩1"
and [simp]:"s⇩2 = cf⇩2#cfs⇩2" by(cases s⇩1,auto,cases s⇩2,fastforce+)
from ‹length ms⇩1 = length s⇩1› ‹s⇩1 ≠ []› have [simp]:"ms⇩1 ≠ []" by(cases ms⇩1) auto
from ‹length ms⇩2 = length s⇩2› ‹s⇩2 ≠ []› have [simp]:"ms⇩2 ≠ []" by(cases ms⇩2) auto
from ‹∀m ∈ set (tl ms⇩1). ∃m'. call_of_return_node m m' ∧ m' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
‹hd ms⇩1 = sourcenode a› ‹ms⇩1 = msx@mx#tl ms⇩2›
‹msx ≠ [] ⟶ (∃mx'. call_of_return_node mx mx' ∧ mx' ∉ ⌊HRB_slice S⌋⇘CFG⇙)›
have [simp]:"mx = sourcenode a" "msx = []" and [simp]:"tl ms⇩2 = tl ms⇩1"
by(cases msx,auto)+
hence "length ms⇩1 = length ms⇩2" by(cases ms⇩2) auto
with ‹length ms⇩1 = length s⇩1› ‹length ms⇩2 = length s⇩2›
have "length s⇩1 = length s⇩2" by simp
from ‹hd ms⇩1 ∈ ⌊HRB_slice S⌋⇘CFG⇙› ‹hd ms⇩1 = sourcenode a›
have "sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙" by simp
with ‹valid_edge a›
have "obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙ = {sourcenode a}"
by(fastforce intro!:n_in_obs_intra)
from ‹∀m ∈ set (tl ms⇩2). ∃m'. call_of_return_node m m' ∧ m' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
‹obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙ = {sourcenode a}›
‹hd ms⇩1 = sourcenode a›
have "(hd ms⇩1#tl ms⇩1) ∈ obs ([]@hd ms⇩1#tl ms⇩1) ⌊HRB_slice S⌋⇘CFG⇙"
by(cases ms⇩1)(auto intro!:obsI)
hence "ms⇩1 ∈ obs ms⇩1 ⌊HRB_slice S⌋⇘CFG⇙" by simp
with ‹obs ms⇩1 ⌊HRB_slice S⌋⇘CFG⇙ = obs ms⇩2 ⌊HRB_slice S⌋⇘CFG⇙›
have "ms⇩1 ∈ obs ms⇩2 ⌊HRB_slice S⌋⇘CFG⇙" by simp
from ‹ms⇩2 ≠ []› ‹length ms⇩2 = length s⇩2› have "length s⇩2 = length (hd ms⇩2#tl ms⇩2)"
by(fastforce dest!:hd_Cons_tl)
from ‹∀m ∈ set (tl ms⇩1). return_node m› have "∀m ∈ set (tl ms⇩2). return_node m"
by simp
with ‹ms⇩1 ∈ obs ms⇩2 ⌊HRB_slice S⌋⇘CFG⇙›
have "hd ms⇩1 ∈ obs_intra (hd ms⇩2) ⌊HRB_slice S⌋⇘CFG⇙"
proof(rule obsE)
fix nsx n nsx' n'
assume "ms⇩2 = nsx @ n # nsx'" and "ms⇩1 = n' # nsx'"
and "n' ∈ obs_intra n ⌊HRB_slice S⌋⇘CFG⇙"
from ‹ms⇩2 = nsx @ n # nsx'› ‹ms⇩1 = n' # nsx'› ‹tl ms⇩2 = tl ms⇩1›
have [simp]:"nsx = []" by(cases nsx) auto
with ‹ms⇩2 = nsx @ n # nsx'› have [simp]:"n = hd ms⇩2" by simp
from ‹ms⇩1 = n' # nsx'› have [simp]:"n' = hd ms⇩1" by simp
with ‹n' ∈ obs_intra n ⌊HRB_slice S⌋⇘CFG⇙› show ?thesis by simp
qed
with ‹length s⇩2 = length (hd ms⇩2#tl ms⇩2)› ‹∀m ∈ set (tl ms⇩2). return_node m›
obtain as where "S,slice_kind S ⊢ (hd ms⇩2#tl ms⇩2,s⇩2) =as⇒⇩τ (hd ms⇩1#tl ms⇩1,s⇩2)"
by(fastforce elim:silent_moves_intra_path_obs[of _ _ _ s⇩2 "tl ms⇩2"])
with ‹ms⇩2 ≠ []› have "S,slice_kind S ⊢ (ms⇩2,s⇩2) =as⇒⇩τ (ms⇩1,s⇩2)"
by(fastforce dest!:hd_Cons_tl)
from ‹valid_edge a› have "valid_node (sourcenode a)" by simp
hence "sourcenode a -[]→⇩ι* sourcenode a"
by(fastforce intro:empty_path simp:intra_path_def)
with ‹sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙›
have "∀V. V ∈ Use⇘SDG⇙ (CFG_node (sourcenode a))
⟶ V ∈ rv S (CFG_node (sourcenode a))"
by auto(rule rvI,auto simp:SDG_to_CFG_set_def sourcenodes_def)
with ‹valid_node (sourcenode a)›
have "∀V ∈ Use (sourcenode a). V ∈ rv S (CFG_node (sourcenode a))"
by(fastforce intro:CFG_Use_SDG_Use)
from ‹∀i < length ms⇩2. ∀V ∈ rv S (CFG_node ((mx#tl ms⇩2)!i)).
(fst (s⇩1!(length msx + i))) V = (fst (s⇩2!i)) V› ‹length ms⇩2 = length s⇩2›
have "∀V∈rv S (CFG_node mx). (fst (s⇩1 ! length msx)) V = state_val s⇩2 V"
by(cases ms⇩2) auto
with ‹∀V ∈ Use (sourcenode a). V ∈ rv S (CFG_node (sourcenode a))›
have "∀V ∈ Use (sourcenode a). fst cf⇩1 V = fst cf⇩2 V" by fastforce
moreover
from ‹∀i<length ms⇩2. snd (s⇩1 ! (length msx + i)) = snd (s⇩2 ! i)›
have "snd (hd s⇩1) = snd (hd s⇩2)" by(erule_tac x="0" in allE) auto
ultimately have "pred (kind a) s⇩2"
using ‹valid_edge a› ‹pred (kind a) s⇩1› ‹length s⇩1 = length s⇩2›
by(fastforce intro:CFG_edge_Uses_pred_equal)
from ‹ms⇩1' = targetnode a # tl ms⇩1› ‹length s⇩1' = length s⇩1›
‹length ms⇩1 = length s⇩1› have "length ms⇩1' = length s⇩1'" by simp
from ‹transfer (kind a) s⇩1 = s⇩1'› ‹intra_kind (kind a)›
obtain cf⇩1' where [simp]:"s⇩1' = cf⇩1'#cfs⇩1"
by(cases cf⇩1,cases "kind a",auto simp:intra_kind_def)
from ‹intra_kind (kind a)› ‹sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙› ‹pred (kind a) s⇩2›
have "pred (slice_kind S a) s⇩2" by(simp add:slice_intra_kind_in_slice)
from ‹valid_edge a› ‹length s⇩1 = length s⇩2› ‹transfer (kind a) s⇩1 = s⇩1'›
have "length s⇩1' = length (transfer (slice_kind S a) s⇩2)"
by(fastforce intro:length_transfer_kind_slice_kind)
with ‹length s⇩1 = length s⇩2›
have "length s⇩2 = length (transfer (slice_kind S a) s⇩2)" by simp
with ‹pred (slice_kind S a) s⇩2› ‹valid_edge a› ‹intra_kind (kind a)›
‹∀m ∈ set (tl ms⇩1). ∃m'. call_of_return_node m m' ∧ m' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
‹hd ms⇩1 ∈ ⌊HRB_slice S⌋⇘CFG⇙› ‹hd ms⇩1 = sourcenode a›
‹length ms⇩1 = length s⇩1› ‹length s⇩1 = length s⇩2›
‹ms⇩1' = targetnode a # tl ms⇩1› ‹∀m ∈ set (tl ms⇩2). return_node m›
have "S,slice_kind S ⊢ (ms⇩1,s⇩2) -a→ (ms⇩1',transfer (slice_kind S a) s⇩2)"
by(auto intro:observable_move.observable_move_intra)
with ‹S,slice_kind S ⊢ (ms⇩2,s⇩2) =as⇒⇩τ (ms⇩1,s⇩2)›
have "S,slice_kind S ⊢ (ms⇩2,s⇩2) =as@[a]⇒ (ms⇩1',transfer (slice_kind S a) s⇩2)"
by(rule observable_moves_snoc)
from ‹∀m ∈ set ms⇩1. valid_node m› ‹ms⇩1' = targetnode a # tl ms⇩1› ‹valid_edge a›
have "∀m ∈ set ms⇩1'. valid_node m" by(cases ms⇩1) auto
from ‹∀m ∈ set (tl ms⇩2). return_node m› ‹ms⇩1' = targetnode a # tl ms⇩1›
‹ms⇩1' = targetnode a # tl ms⇩1›
have "∀m ∈ set (tl ms⇩1'). return_node m" by fastforce
from ‹ms⇩1' = targetnode a # tl ms⇩1› ‹tl ms⇩2 = tl ms⇩1›
have "ms⇩1' = [] @ targetnode a # tl ms⇩2" by simp
from ‹intra_kind (kind a)› ‹sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙›
have cf2':"∃cf⇩2'. transfer (slice_kind S a) s⇩2 = cf⇩2'#cfs⇩2 ∧ snd cf⇩2' = snd cf⇩2"
by(cases cf⇩2)(auto dest:slice_intra_kind_in_slice simp:intra_kind_def)
from ‹transfer (kind a) s⇩1 = s⇩1'› ‹intra_kind (kind a)›
have "snd cf⇩1' = snd cf⇩1" by(auto simp:intra_kind_def)
with ‹∀i<length ms⇩2. snd (s⇩1 ! (length msx + i)) = snd (s⇩2 ! i)›
‹snd (hd s⇩1) = snd (hd s⇩2)› ‹ms⇩1' = [] @ targetnode a # tl ms⇩2›
cf2' ‹length ms⇩1 = length ms⇩2›
have "∀i<length ms⇩1'. snd (s⇩1' ! i) = snd (transfer (slice_kind S a) s⇩2 ! i)"
by auto(case_tac i,auto)
have "∀V ∈ rv S (CFG_node (targetnode a)).
fst cf⇩1' V = state_val (transfer (slice_kind S a) s⇩2) V"
proof
fix V assume "V ∈ rv S (CFG_node (targetnode a))"
show "fst cf⇩1' V = state_val (transfer (slice_kind S a) s⇩2) V"
proof(cases "V ∈ Def (sourcenode a)")
case True
from ‹intra_kind (kind a)› have "(∃f. kind a = ⇑f) ∨ (∃Q. kind a = (Q)⇩√)"
by(simp add:intra_kind_def)
thus ?thesis
proof
assume "∃f. kind a = ⇑f"
then obtain f' where "kind a = ⇑f'" by blast
with ‹transfer (kind a) s⇩1 = s⇩1'›
have "s⇩1' = (f' (fst cf⇩1),snd cf⇩1) # cfs⇩1" by simp
from ‹sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙› ‹kind a = ⇑f'›
have "slice_kind S a = ⇑f'"
by(fastforce dest:slice_intra_kind_in_slice simp:intra_kind_def)
hence "transfer (slice_kind S a) s⇩2 = (f' (fst cf⇩2),snd cf⇩2) # cfs⇩2" by simp
from ‹valid_edge a› ‹∀V ∈ Use (sourcenode a). fst cf⇩1 V = fst cf⇩2 V›
‹intra_kind (kind a)› ‹pred (kind a) s⇩1› ‹pred (kind a) s⇩2›
have "∀V ∈ Def (sourcenode a). state_val (transfer (kind a) s⇩1) V =
state_val (transfer (kind a) s⇩2) V"
by -(erule CFG_intra_edge_transfer_uses_only_Use,auto)
with ‹kind a = ⇑f'› ‹s⇩1' = (f' (fst cf⇩1),snd cf⇩1) # cfs⇩1› True
‹transfer (slice_kind S a) s⇩2 = (f' (fst cf⇩2),snd cf⇩2) # cfs⇩2›
show ?thesis by simp
next
assume "∃Q. kind a = (Q)⇩√"
then obtain Q where "kind a = (Q)⇩√" by blast
with ‹transfer (kind a) s⇩1 = s⇩1'› have "s⇩1' = cf⇩1 # cfs⇩1" by simp
from ‹sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙› ‹kind a = (Q)⇩√›
have "slice_kind S a = (Q)⇩√"
by(fastforce dest:slice_intra_kind_in_slice simp:intra_kind_def)
hence "transfer (slice_kind S a) s⇩2 = s⇩2" by simp
from ‹valid_edge a› ‹∀V ∈ Use (sourcenode a). fst cf⇩1 V = fst cf⇩2 V›
‹intra_kind (kind a)› ‹pred (kind a) s⇩1› ‹pred (kind a) s⇩2›
have "∀V ∈ Def (sourcenode a). state_val (transfer (kind a) s⇩1) V =
state_val (transfer (kind a) s⇩2) V"
by -(erule CFG_intra_edge_transfer_uses_only_Use,auto simp:intra_kind_def)
with True ‹kind a = (Q)⇩√› ‹s⇩1' = cf⇩1 # cfs⇩1›
‹transfer (slice_kind S a) s⇩2 = s⇩2›
show ?thesis by simp
qed
next
case False
with ‹valid_edge a› ‹intra_kind (kind a)› ‹pred (kind a) s⇩1›
have "state_val (transfer (kind a) s⇩1) V = state_val s⇩1 V"
by(fastforce intro:CFG_intra_edge_no_Def_equal)
with ‹transfer (kind a) s⇩1 = s⇩1'› have "fst cf⇩1' V = fst cf⇩1 V" by simp
from ‹sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙› ‹intra_kind (kind a)›
have "slice_kind S a = kind a" by(fastforce intro:slice_intra_kind_in_slice)
from False ‹valid_edge a› ‹pred (kind a) s⇩2› ‹intra_kind (kind a)›
have "state_val (transfer (kind a) s⇩2) V = state_val s⇩2 V"
by(fastforce intro:CFG_intra_edge_no_Def_equal)
with ‹slice_kind S a = kind a›
have "state_val (transfer (slice_kind S a) s⇩2) V = fst cf⇩2 V" by simp
from ‹V ∈ rv S (CFG_node (targetnode a))› obtain as' nx
where "targetnode a -as'→⇩ι* parent_node nx"
and "nx ∈ HRB_slice S" and "V ∈ Use⇘SDG⇙ nx"
and "∀n''. valid_SDG_node n'' ∧ parent_node n'' ∈ set (sourcenodes as')
⟶ V ∉ Def⇘SDG⇙ n''"
by(fastforce elim:rvE)
with ‹∀n''. valid_SDG_node n'' ∧ parent_node n'' ∈ set (sourcenodes as')
⟶ V ∉ Def⇘SDG⇙ n''› False
have all:"∀n''. valid_SDG_node n'' ∧
parent_node n'' ∈ set (sourcenodes (a#as')) ⟶ V ∉ Def⇘SDG⇙ n''"
by(fastforce dest:SDG_Def_parent_Def simp:sourcenodes_def)
from ‹valid_edge a› ‹targetnode a -as'→⇩ι* parent_node nx›
‹intra_kind (kind a)›
have "sourcenode a -a#as'→⇩ι* parent_node nx"
by(fastforce intro:Cons_path simp:intra_path_def)
with ‹nx ∈ HRB_slice S› ‹V ∈ Use⇘SDG⇙ nx› all
have "V ∈ rv S (CFG_node (sourcenode a))" by(fastforce intro:rvI)
with ‹∀V ∈ rv S (CFG_node mx). (fst (s⇩1!(length msx))) V = state_val s⇩2 V›
‹state_val (transfer (slice_kind S a) s⇩2) V = fst cf⇩2 V›
‹fst cf⇩1' V = fst cf⇩1 V›
show ?thesis by fastforce
qed
qed
with ‹∀i < length ms⇩2. ∀V ∈ rv S (CFG_node ((mx#tl ms⇩2)!i)).
(fst (s⇩1!(length msx + i))) V = (fst (s⇩2!i)) V› cf2'
‹ms⇩1' = [] @ targetnode a # tl ms⇩2›
‹length ms⇩1 = length s⇩1› ‹length ms⇩2 = length s⇩2› ‹length s⇩1 = length s⇩2›
have "∀i<length ms⇩1'. ∀V∈rv S (CFG_node ((targetnode a # tl ms⇩1')!i)).
(fst (s⇩1'!(length [] + i))) V = (fst (transfer (slice_kind S a) s⇩2 ! i)) V"
by clarsimp(case_tac i,auto)
with ‹∀m ∈ set ms⇩2. valid_node m› ‹∀m ∈ set ms⇩1'. valid_node m›
‹length ms⇩2 = length s⇩2› ‹length s⇩1' = length (transfer (slice_kind S a) s⇩2)›
‹length ms⇩1' = length s⇩1'› ‹∀m ∈ set (tl ms⇩1'). return_node m›
‹ms⇩1' = [] @ targetnode a # tl ms⇩2› ‹get_proc mx = get_proc (hd ms⇩2)›
‹∀m ∈ set (tl ms⇩1). ∃m'. call_of_return_node m m' ∧ m' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
‹∀i<length ms⇩1'. snd (s⇩1' ! i) = snd (transfer (slice_kind S a) s⇩2 ! i)›
have "((ms⇩1',s⇩1'),(ms⇩1',transfer (slice_kind S a) s⇩2)) ∈ WS S"
by(fastforce intro!:WSI)
with ‹S,slice_kind S ⊢ (ms⇩2,s⇩2) =as@[a]⇒ (ms⇩1',transfer (slice_kind S a) s⇩2)›
show ?case by blast
next
case (observable_move_call a s⇩1 s⇩1' Q r p fs a' ms⇩1 S ms⇩1')
from ‹s⇩1 ≠ []› ‹s⇩2 ≠ []› obtain cf⇩1 cfs⇩1 cf⇩2 cfs⇩2 where [simp]:"s⇩1 = cf⇩1#cfs⇩1"
and [simp]:"s⇩2 = cf⇩2#cfs⇩2" by(cases s⇩1,auto,cases s⇩2,fastforce+)
from ‹length ms⇩1 = length s⇩1› ‹s⇩1 ≠ []› have [simp]:"ms⇩1 ≠ []" by(cases ms⇩1) auto
from ‹length ms⇩2 = length s⇩2› ‹s⇩2 ≠ []› have [simp]:"ms⇩2 ≠ []" by(cases ms⇩2) auto
from ‹∀m ∈ set (tl ms⇩1). ∃m'. call_of_return_node m m' ∧ m' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
‹hd ms⇩1 = sourcenode a› ‹ms⇩1 = msx@mx#tl ms⇩2›
‹msx ≠ [] ⟶ (∃mx'. call_of_return_node mx mx' ∧ mx' ∉ ⌊HRB_slice S⌋⇘CFG⇙)›
have [simp]:"mx = sourcenode a" "msx = []" and [simp]:"tl ms⇩2 = tl ms⇩1"
by(cases msx,auto)+
hence "length ms⇩1 = length ms⇩2" by(cases ms⇩2) auto
with ‹length ms⇩1 = length s⇩1› ‹length ms⇩2 = length s⇩2›
have "length s⇩1 = length s⇩2" by simp
from ‹hd ms⇩1 ∈ ⌊HRB_slice S⌋⇘CFG⇙› ‹hd ms⇩1 = sourcenode a›
have "sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙" by simp
with ‹valid_edge a›
have "obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙ = {sourcenode a}"
by(fastforce intro!:n_in_obs_intra)
from ‹∀m ∈ set (tl ms⇩2). ∃m'. call_of_return_node m m' ∧ m' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
‹obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙ = {sourcenode a}›
‹hd ms⇩1 = sourcenode a›
have "(hd ms⇩1#tl ms⇩1) ∈ obs ([]@hd ms⇩1#tl ms⇩1) ⌊HRB_slice S⌋⇘CFG⇙"
by(cases ms⇩1)(auto intro!:obsI)
hence "ms⇩1 ∈ obs ms⇩1 ⌊HRB_slice S⌋⇘CFG⇙" by simp
with ‹obs ms⇩1 ⌊HRB_slice S⌋⇘CFG⇙ = obs ms⇩2 ⌊HRB_slice S⌋⇘CFG⇙›
have "ms⇩1 ∈ obs ms⇩2 ⌊HRB_slice S⌋⇘CFG⇙" by simp
from ‹ms⇩2 ≠ []› ‹length ms⇩2 = length s⇩2› have "length s⇩2 = length (hd ms⇩2#tl ms⇩2)"
by(fastforce dest!:hd_Cons_tl)
from ‹∀m ∈ set (tl ms⇩1). return_node m› have "∀m ∈ set (tl ms⇩2). return_node m"
by simp
with ‹ms⇩1 ∈ obs ms⇩2 ⌊HRB_slice S⌋⇘CFG⇙›
have "hd ms⇩1 ∈ obs_intra (hd ms⇩2) ⌊HRB_slice S⌋⇘CFG⇙"
proof(rule obsE)
fix nsx n nsx' n'
assume "ms⇩2 = nsx @ n # nsx'" and "ms⇩1 = n' # nsx'"
and "n' ∈ obs_intra n ⌊HRB_slice S⌋⇘CFG⇙"
from ‹ms⇩2 = nsx @ n # nsx'› ‹ms⇩1 = n' # nsx'› ‹tl ms⇩2 = tl ms⇩1›
have [simp]:"nsx = []" by(cases nsx) auto
with ‹ms⇩2 = nsx @ n # nsx'› have [simp]:"n = hd ms⇩2" by simp
from ‹ms⇩1 = n' # nsx'› have [simp]:"n' = hd ms⇩1" by simp
with ‹n' ∈ obs_intra n ⌊HRB_slice S⌋⇘CFG⇙› show ?thesis by simp
qed
with ‹length s⇩2 = length (hd ms⇩2#tl ms⇩2)› ‹∀m ∈ set (tl ms⇩2). return_node m›
obtain as where "S,slice_kind S ⊢ (hd ms⇩2#tl ms⇩2,s⇩2) =as⇒⇩τ (hd ms⇩1#tl ms⇩1,s⇩2)"
by(fastforce elim:silent_moves_intra_path_obs[of _ _ _ s⇩2 "tl ms⇩2"])
with ‹ms⇩2 ≠ []› have "S,slice_kind S ⊢ (ms⇩2,s⇩2) =as⇒⇩τ (ms⇩1,s⇩2)"
by(fastforce dest!:hd_Cons_tl)
from ‹valid_edge a› have "valid_node (sourcenode a)" by simp
hence "sourcenode a -[]→⇩ι* sourcenode a"
by(fastforce intro:empty_path simp:intra_path_def)
with ‹sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙›
have "∀V. V ∈ Use⇘SDG⇙ (CFG_node (sourcenode a))
⟶ V ∈ rv S (CFG_node (sourcenode a))"
by auto(rule rvI,auto simp:SDG_to_CFG_set_def sourcenodes_def)
with ‹valid_node (sourcenode a)›
have "∀V ∈ Use (sourcenode a). V ∈ rv S (CFG_node (sourcenode a))"
by(fastforce intro:CFG_Use_SDG_Use)
from ‹∀i < length ms⇩2. ∀V ∈ rv S (CFG_node ((mx#tl ms⇩2)!i)).
(fst (s⇩1!(length msx + i))) V = (fst (s⇩2!i)) V› ‹length ms⇩2 = length s⇩2›
have "∀V∈rv S (CFG_node mx). (fst (s⇩1 ! length msx)) V = state_val s⇩2 V"
by(cases ms⇩2) auto
with ‹∀V ∈ Use (sourcenode a). V ∈ rv S (CFG_node (sourcenode a))›
have "∀V ∈ Use (sourcenode a). fst cf⇩1 V = fst cf⇩2 V" by fastforce
moreover
from ‹∀i<length ms⇩2. snd (s⇩1 ! (length msx + i)) = snd (s⇩2 ! i)›
have "snd (hd s⇩1) = snd (hd s⇩2)" by(erule_tac x="0" in allE) auto
ultimately have "pred (kind a) s⇩2"
using ‹valid_edge a› ‹pred (kind a) s⇩1› ‹length s⇩1 = length s⇩2›
by(fastforce intro:CFG_edge_Uses_pred_equal)
from ‹ms⇩1' = (targetnode a)#(targetnode a')#tl ms⇩1› ‹length s⇩1' = Suc(length s⇩1)›
‹length ms⇩1 = length s⇩1› have "length ms⇩1' = length s⇩1'" by simp
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› obtain ins outs
where "(p,ins,outs) ∈ set procs" by(fastforce dest!:callee_in_procs)
with ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs›
have "(THE ins. ∃outs. (p,ins,outs) ∈ set procs) = ins"
by(rule formal_in_THE)
with ‹transfer (kind a) s⇩1 = s⇩1'› ‹kind a = Q:r↪⇘p⇙fs›
have [simp]:"s⇩1' = (Map.empty(ins [:=] params fs (fst cf⇩1)),r)#cf⇩1#cfs⇩1" by simp
from ‹valid_edge a'› ‹a' ∈ get_return_edges a› ‹valid_edge a›
have "return_node (targetnode a')" by(fastforce simp:return_node_def)
with ‹valid_edge a› ‹valid_edge a'› ‹a' ∈ get_return_edges a›
have "call_of_return_node (targetnode a') (sourcenode a)"
by(simp add:call_of_return_node_def) blast
from ‹sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙› ‹pred (kind a) s⇩2› ‹kind a = Q:r↪⇘p⇙fs›
have "pred (slice_kind S a) s⇩2" by(fastforce dest:slice_kind_Call_in_slice)
from ‹valid_edge a› ‹length s⇩1 = length s⇩2› ‹transfer (kind a) s⇩1 = s⇩1'›
have "length s⇩1' = length (transfer (slice_kind S a) s⇩2)"
by(fastforce intro:length_transfer_kind_slice_kind)
with ‹pred (slice_kind S a) s⇩2› ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs›
‹∀m ∈ set (tl ms⇩1). ∃m'. call_of_return_node m m' ∧ m' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
‹hd ms⇩1 ∈ ⌊HRB_slice S⌋⇘CFG⇙› ‹hd ms⇩1 = sourcenode a›
‹length ms⇩1 = length s⇩1› ‹length s⇩1 = length s⇩2› ‹valid_edge a'›
‹ms⇩1' = (targetnode a)#(targetnode a')#tl ms⇩1› ‹a' ∈ get_return_edges a›
‹∀m ∈ set (tl ms⇩2). return_node m›
have "S,slice_kind S ⊢ (ms⇩1,s⇩2) -a→ (ms⇩1',transfer (slice_kind S a) s⇩2)"
by(auto intro:observable_move.observable_move_call)
with ‹S,slice_kind S ⊢ (ms⇩2,s⇩2) =as⇒⇩τ (ms⇩1,s⇩2)›
have "S,slice_kind S ⊢ (ms⇩2,s⇩2) =as@[a]⇒ (ms⇩1',transfer (slice_kind S a) s⇩2)"
by(rule observable_moves_snoc)
from ‹∀m ∈ set ms⇩1. valid_node m› ‹ms⇩1' = (targetnode a)#(targetnode a')#tl ms⇩1›
‹valid_edge a› ‹valid_edge a'›
have "∀m ∈ set ms⇩1'. valid_node m" by(cases ms⇩1) auto
from ‹kind a = Q:r↪⇘p⇙fs› ‹sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙›
have cf2':"∃cf⇩2'. transfer (slice_kind S a) s⇩2 = cf⇩2'#s⇩2 ∧ snd cf⇩2' = r"
by(auto dest:slice_kind_Call_in_slice)
with ‹∀i<length ms⇩2. snd (s⇩1 ! (length msx + i)) = snd (s⇩2 ! i)›
‹length ms⇩1' = length s⇩1'› ‹msx = []› ‹length ms⇩1 = length ms⇩2›
‹length ms⇩1 = length s⇩1›
have "∀i<length ms⇩1'. snd (s⇩1' ! i) = snd (transfer (slice_kind S a) s⇩2 ! i)"
by auto(case_tac i,auto)
have "∀V ∈ rv S (CFG_node (targetnode a')).
V ∈ rv S (CFG_node (sourcenode a))"
proof
fix V assume "V ∈ rv S (CFG_node (targetnode a'))"
then obtain as n' where "targetnode a' -as→⇩ι* parent_node n'"
and "n' ∈ HRB_slice S" and "V ∈ Use⇘SDG⇙ n'"
and "∀n''. valid_SDG_node n'' ∧ parent_node n'' ∈ set (sourcenodes as)
⟶ V ∉ Def⇘SDG⇙ n''" by(fastforce elim:rvE)
from ‹valid_edge a› ‹a' ∈ get_return_edges a›
obtain a'' where "valid_edge a''" and "sourcenode a'' = sourcenode a"
and "targetnode a'' = targetnode a'" and "intra_kind(kind a'')"
by -(drule call_return_node_edge,auto simp:intra_kind_def)
with ‹targetnode a' -as→⇩ι* parent_node n'›
have "sourcenode a -a''#as→⇩ι* parent_node n'"
by(fastforce intro:Cons_path simp:intra_path_def)
from ‹sourcenode a'' = sourcenode a› ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs›
have "∀n''. valid_SDG_node n'' ∧ parent_node n'' = sourcenode a''
⟶ V ∉ Def⇘SDG⇙ n''"
by(fastforce dest:SDG_Def_parent_Def call_source_Def_empty)
with ‹∀n''. valid_SDG_node n'' ∧ parent_node n'' ∈ set (sourcenodes as)
⟶ V ∉ Def⇘SDG⇙ n''›
have "∀n''. valid_SDG_node n'' ∧ parent_node n'' ∈ set (sourcenodes (a''#as))
⟶ V ∉ Def⇘SDG⇙ n''" by(fastforce simp:sourcenodes_def)
with ‹sourcenode a -a''#as→⇩ι* parent_node n'› ‹n' ∈ HRB_slice S›
‹V ∈ Use⇘SDG⇙ n'›
show "V ∈ rv S (CFG_node (sourcenode a))" by(fastforce intro:rvI)
qed
have "∀V ∈ rv S (CFG_node (targetnode a)).
(Map.empty(ins [:=] params fs (fst cf⇩1))) V =
state_val (transfer (slice_kind S a) s⇩2) V"
proof
fix V assume "V ∈ rv S (CFG_node (targetnode a))"
from ‹sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙› ‹kind a = Q:r↪⇘p⇙fs›
‹(THE ins. ∃outs. (p,ins,outs) ∈ set procs) = ins›
have eq:"fst (hd (transfer (slice_kind S a) s⇩2)) =
Map.empty(ins [:=] params (cspp (targetnode a) (HRB_slice S) fs) (fst cf⇩2))"
by(auto dest:slice_kind_Call_in_slice)
show "(Map.empty(ins [:=] params fs (fst cf⇩1))) V =
state_val (transfer (slice_kind S a) s⇩2) V"
proof(cases "V ∈ set ins")
case True
then obtain i where "V = ins!i" and "i < length ins"
by(auto simp:in_set_conv_nth)
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹(p,ins,outs) ∈ set procs›
‹i < length ins›
have "valid_SDG_node (Formal_in (targetnode a,i))" by fastforce
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› have "get_proc(targetnode a) = p"
by(rule get_proc_call)
with ‹valid_SDG_node (Formal_in (targetnode a,i))›
‹(p,ins,outs) ∈ set procs› ‹V = ins!i›
have "V ∈ Def⇘SDG⇙ (Formal_in (targetnode a,i))"
by(fastforce intro:Formal_in_SDG_Def)
from ‹V ∈ rv S (CFG_node (targetnode a))› obtain as' nx
where "targetnode a -as'→⇩ι* parent_node nx"
and "nx ∈ HRB_slice S" and "V ∈ Use⇘SDG⇙ nx"
and "∀n''. valid_SDG_node n'' ∧
parent_node n'' ∈ set (sourcenodes as') ⟶ V ∉ Def⇘SDG⇙ n''"
by(fastforce elim:rvE)
with ‹valid_SDG_node (Formal_in (targetnode a,i))›
‹V ∈ Def⇘SDG⇙ (Formal_in (targetnode a,i))›
have "targetnode a = parent_node nx"
apply(auto simp:intra_path_def sourcenodes_def)
apply(erule path.cases) apply fastforce
apply(erule_tac x="Formal_in (targetnode a,i)" in allE) by fastforce
with ‹V ∈ Use⇘SDG⇙ nx› have "V ∈ Use (targetnode a)"
by(fastforce intro:SDG_Use_parent_Use)
with ‹valid_edge a› have "V ∈ Use⇘SDG⇙ (CFG_node (targetnode a))"
by(auto intro!:CFG_Use_SDG_Use)
from ‹targetnode a = parent_node nx›[THEN sym] ‹valid_edge a›
have "parent_node (Formal_in (targetnode a,i)) -[]→⇩ι* parent_node nx"
by(fastforce intro:empty_path simp:intra_path_def)
with ‹V ∈ Def⇘SDG⇙ (Formal_in (targetnode a,i))›
‹V ∈ Use⇘SDG⇙ (CFG_node (targetnode a))› ‹targetnode a = parent_node nx›
have "Formal_in (targetnode a,i) influences V in (CFG_node (targetnode a))"
by(fastforce simp:data_dependence_def sourcenodes_def)
hence ddep:"Formal_in (targetnode a,i) s-V→⇩d⇩d (CFG_node (targetnode a))"
by(rule sum_SDG_ddep_edge)
from ‹targetnode a = parent_node nx› ‹nx ∈ HRB_slice S›
have "CFG_node (targetnode a) ∈ HRB_slice S"
by(fastforce dest:valid_SDG_node_in_slice_parent_node_in_slice)
hence "Formal_in (targetnode a,i) ∈ HRB_slice S"
proof(induct "CFG_node (targetnode a)" rule:HRB_slice_cases)
case (phase1 nx)
with ddep show ?case
by(fastforce intro:ddep_slice1 combine_SDG_slices.combSlice_refl
simp:HRB_slice_def)
next
case (phase2 nx n' n'' p)
from ‹CFG_node (targetnode a) ∈ sum_SDG_slice2 n'› ddep
have "Formal_in (targetnode a,i) ∈ sum_SDG_slice2 n'"
by(fastforce intro:ddep_slice2)
with ‹n'' s-p→⇘ret⇙ CFG_node (parent_node n')› ‹n' ∈ sum_SDG_slice1 nx›
‹nx ∈ S›
show ?case by(fastforce intro:combine_SDG_slices.combSlice_Return_parent_node simp:HRB_slice_def)
qed
from ‹sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙› ‹kind a = Q:r↪⇘p⇙fs›
have slice_kind:"slice_kind S a =
Q:r↪⇘p⇙(cspp (targetnode a) (HRB_slice S) fs)"
by(rule slice_kind_Call_in_slice)
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹(p,ins,outs) ∈ set procs›
have "length fs = length ins" by(rule CFG_call_edge_length)
from ‹Formal_in (targetnode a,i) ∈ HRB_slice S›
‹length fs = length ins› ‹i < length ins›
have cspp:"(cspp (targetnode a) (HRB_slice S) fs)!i = fs!i"
by(fastforce intro:csppa_Formal_in_in_slice simp:cspp_def)
from ‹i < length ins› ‹length fs = length ins›
have "(params (cspp (targetnode a) (HRB_slice S) fs) (fst cf⇩2))!i =
((cspp (targetnode a) (HRB_slice S) fs)!i) (fst cf⇩2)"
by(fastforce intro:params_nth)
with cspp
have eq:"(params (cspp (targetnode a) (HRB_slice S) fs) (fst cf⇩2))!i =
(fs!i) (fst cf⇩2)" by simp
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹(p,ins,outs) ∈ set procs›
have "(THE ins. ∃outs. (p,ins,outs) ∈ set procs) = ins"
by(rule formal_in_THE)
with slice_kind
have "fst (hd (transfer (slice_kind S a) s⇩2)) =
Map.empty(ins [:=] params (cspp (targetnode a) (HRB_slice S) fs) (fst cf⇩2))"
by simp
moreover
from ‹(p,ins,outs) ∈ set procs› have "distinct ins"
by(rule distinct_formal_ins)
ultimately have "state_val (transfer (slice_kind S a) s⇩2) V =
(params (cspp (targetnode a) (HRB_slice S) fs) (fst cf⇩2))!i"
using ‹V = ins!i› ‹i < length ins› ‹length fs = length ins›
by(fastforce intro:fun_upds_nth)
with eq
have 2:"state_val (transfer (slice_kind S a) s⇩2) V = (fs!i) (fst cf⇩2)"
by simp
from ‹V = ins!i› ‹i < length ins› ‹length fs = length ins›
‹distinct ins›
have "Map.empty(ins [:=] params fs (fst cf⇩1)) V = (params fs (fst cf⇩1))!i"
by(fastforce intro:fun_upds_nth)
with ‹i < length ins› ‹length fs = length ins›
have 1:"Map.empty(ins [:=] params fs (fst cf⇩1)) V = (fs!i) (fst cf⇩1)"
by(fastforce intro:params_nth)
from ‹∀i < length ms⇩2. ∀V ∈ rv S (CFG_node ((mx#tl ms⇩2)!i)).
(fst (s⇩1!(length msx + i))) V = (fst (s⇩2!i)) V›
have rv:"∀V∈rv S (CFG_node (sourcenode a)). fst cf⇩1 V = fst cf⇩2 V"
by(erule_tac x="0" in allE) auto
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹(p,ins,outs) ∈ set procs›
‹i < length ins› have "∀V∈(ParamUses (sourcenode a)!i).
V ∈ Use⇘SDG⇙ (Actual_in (sourcenode a,i))"
by(fastforce intro:Actual_in_SDG_Use)
with ‹valid_edge a› have "∀V∈(ParamUses (sourcenode a)!i).
V ∈ Use⇘SDG⇙ (CFG_node (sourcenode a))"
by(auto intro!:CFG_Use_SDG_Use dest:SDG_Use_parent_Use)
moreover
from ‹valid_edge a› have "parent_node (CFG_node (sourcenode a)) -[]→⇩ι*
parent_node (CFG_node (sourcenode a))"
by(fastforce intro:empty_path simp:intra_path_def)
ultimately
have "∀V∈(ParamUses (sourcenode a)!i). V ∈ rv S (CFG_node (sourcenode a))"
using ‹sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙› ‹valid_edge a›
by(fastforce intro:rvI simp:SDG_to_CFG_set_def sourcenodes_def)
with rv have "∀V ∈ (ParamUses (sourcenode a))!i. fst cf⇩1 V = fst cf⇩2 V"
by fastforce
with ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹i < length ins›
‹(p,ins,outs) ∈ set procs› ‹pred (kind a) s⇩1› ‹pred (kind a) s⇩2›
have "(params fs (fst cf⇩1))!i = (params fs (fst cf⇩2))!i"
by(fastforce dest!:CFG_call_edge_params)
moreover
from ‹i < length ins› ‹length fs = length ins›
have "(params fs (fst cf⇩1))!i = (fs!i) (fst cf⇩1)"
and "(params fs (fst cf⇩2))!i = (fs!i) (fst cf⇩2)"
by(auto intro:params_nth)
ultimately show ?thesis using 1 2 by simp
next
case False
with eq show ?thesis by(fastforce simp:fun_upds_notin)
qed
qed
with ‹∀i < length ms⇩2. ∀V ∈ rv S (CFG_node ((mx#tl ms⇩2)!i)).
(fst (s⇩1!(length msx + i))) V = (fst (s⇩2!i)) V› cf2' ‹tl ms⇩2 = tl ms⇩1›
‹length ms⇩2 = length s⇩2› ‹length ms⇩1 = length s⇩1› ‹length s⇩1 = length s⇩2›
‹ms⇩1' = (targetnode a)#(targetnode a')#tl ms⇩1›
‹∀V ∈ rv S (CFG_node (targetnode a')). V ∈ rv S (CFG_node (sourcenode a))›
have "∀i<length ms⇩1'. ∀V∈rv S (CFG_node ((targetnode a # tl ms⇩1')!i)).
(fst (s⇩1'!(length [] + i))) V = (fst (transfer (slice_kind S a) s⇩2!i)) V"
apply clarsimp apply(case_tac i) apply auto
apply(erule_tac x="nat" in allE)
apply(case_tac nat) apply auto done
with ‹∀m ∈ set ms⇩2. valid_node m› ‹∀m ∈ set ms⇩1'. valid_node m›
‹length ms⇩2 = length s⇩2› ‹length s⇩1' = length (transfer (slice_kind S a) s⇩2)›
‹length ms⇩1' = length s⇩1'› ‹ms⇩1' = (targetnode a)#(targetnode a')#tl ms⇩1›
‹get_proc mx = get_proc (hd ms⇩2)› ‹sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙›
‹∀m ∈ set (tl ms⇩1). ∃m'. call_of_return_node m m' ∧ m' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
‹return_node (targetnode a')› ‹∀m ∈ set (tl ms⇩1). return_node m›
‹call_of_return_node (targetnode a') (sourcenode a)›
‹∀i<length ms⇩1'. snd (s⇩1' ! i) = snd (transfer (slice_kind S a) s⇩2 ! i)›
have "((ms⇩1',s⇩1'),(ms⇩1',transfer (slice_kind S a) s⇩2)) ∈ WS S"
by(fastforce intro!:WSI)
with ‹S,slice_kind S ⊢ (ms⇩2,s⇩2) =as@[a]⇒ (ms⇩1',transfer (slice_kind S a) s⇩2)›
show ?case by blast
next
case (observable_move_return a s⇩1 s⇩1' Q p f' ms⇩1 S ms⇩1')
from ‹s⇩1 ≠ []› ‹s⇩2 ≠ []› obtain cf⇩1 cfs⇩1 cf⇩2 cfs⇩2 where [simp]:"s⇩1 = cf⇩1#cfs⇩1"
and [simp]:"s⇩2 = cf⇩2#cfs⇩2" by(cases s⇩1,auto,cases s⇩2,fastforce+)
from ‹length ms⇩1 = length s⇩1› ‹s⇩1 ≠ []› have [simp]:"ms⇩1 ≠ []" by(cases ms⇩1) auto
from ‹length ms⇩2 = length s⇩2› ‹s⇩2 ≠ []› have [simp]:"ms⇩2 ≠ []" by(cases ms⇩2) auto
from ‹∀m ∈ set (tl ms⇩1). ∃m'. call_of_return_node m m' ∧ m' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
‹hd ms⇩1 = sourcenode a› ‹ms⇩1 = msx@mx#tl ms⇩2›
‹msx ≠ [] ⟶ (∃mx'. call_of_return_node mx mx' ∧ mx' ∉ ⌊HRB_slice S⌋⇘CFG⇙)›
have [simp]:"mx = sourcenode a" "msx = []" and [simp]:"tl ms⇩2 = tl ms⇩1"
by(cases msx,auto)+
hence "length ms⇩1 = length ms⇩2" by(cases ms⇩2) auto
with ‹length ms⇩1 = length s⇩1› ‹length ms⇩2 = length s⇩2›
have "length s⇩1 = length s⇩2" by simp
have "∃as. S,slice_kind S ⊢ (ms⇩2,s⇩2) =as⇒⇩τ (ms⇩1,s⇩2)"
proof(cases "obs_intra (hd ms⇩2) ⌊HRB_slice S⌋⇘CFG⇙ = {}")
case True
from ‹valid_edge a› ‹hd ms⇩1 = sourcenode a› ‹kind a = Q↩⇘p⇙f'›
have "method_exit (hd ms⇩1)" by(fastforce simp:method_exit_def)
from ‹∀m∈set ms⇩2. valid_node m› have "valid_node (hd ms⇩2)" by(cases ms⇩2) auto
then obtain asx where "hd ms⇩2 -asx→⇩√* (_Exit_)" by(fastforce dest!:Exit_path)
then obtain as pex where "hd ms⇩2 -as→⇩ι* pex" and "method_exit pex"
by(fastforce elim:valid_Exit_path_intra_path)
from ‹hd ms⇩2 -as→⇩ι* pex› have "get_proc (hd ms⇩2) = get_proc pex"
by(rule intra_path_get_procs)
with ‹get_proc mx = get_proc (hd ms⇩2)›
have "get_proc mx = get_proc pex" by simp
with ‹method_exit (hd ms⇩1)› ‹ hd ms⇩1 = sourcenode a› ‹method_exit pex›
have [simp]:"pex = hd ms⇩1" by(fastforce intro:method_exit_unique)
from ‹obs_intra (hd ms⇩2) ⌊HRB_slice S⌋⇘CFG⇙ = {}› ‹method_exit pex›
‹get_proc (hd ms⇩2) = get_proc pex› ‹valid_node (hd ms⇩2)›
‹length ms⇩2 = length s⇩2› ‹∀m∈set (tl ms⇩1). return_node m› ‹ms⇩2 ≠ []›
obtain as'
where "S,slice_kind S ⊢ (hd ms⇩2#tl ms⇩2,s⇩2) =as'⇒⇩τ (hd ms⇩1#tl ms⇩1,s⇩2)"
by(fastforce elim!:silent_moves_intra_path_no_obs[of _ _ _ s⇩2 "tl ms⇩2"]
dest:hd_Cons_tl)
with ‹ms⇩2 ≠ []› have "S,slice_kind S ⊢ (ms⇩2,s⇩2) =as'⇒⇩τ (ms⇩1,s⇩2)"
by(fastforce dest!:hd_Cons_tl)
thus ?thesis by blast
next
case False
then obtain x where "x ∈ obs_intra (hd ms⇩2) ⌊HRB_slice S⌋⇘CFG⇙" by fastforce
hence "obs_intra (hd ms⇩2) ⌊HRB_slice S⌋⇘CFG⇙ = {x}"
by(rule obs_intra_singleton_element)
with ‹∀m ∈ set (tl ms⇩2). ∃m'. call_of_return_node m m' ∧ m' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
have "x#tl ms⇩1 ∈ obs ([]@hd ms⇩2#tl ms⇩2) ⌊HRB_slice S⌋⇘CFG⇙"
by(fastforce intro:obsI)
with ‹ms⇩2 ≠ []› have "x#tl ms⇩1 ∈ obs ms⇩2 ⌊HRB_slice S⌋⇘CFG⇙"
by(fastforce dest:hd_Cons_tl simp del:obs.simps)
with ‹obs ms⇩1 ⌊HRB_slice S⌋⇘CFG⇙ = obs ms⇩2 ⌊HRB_slice S⌋⇘CFG⇙›
have "x#tl ms⇩1 ∈ obs ms⇩1 ⌊HRB_slice S⌋⇘CFG⇙" by simp
from this ‹∀m∈set (tl ms⇩1). return_node m›
have "x ∈ obs_intra (hd ms⇩1) ⌊HRB_slice S⌋⇘CFG⇙"
proof(rule obsE)
fix nsx n nsx' n'
assume "ms⇩1 = nsx @ n # nsx'" and "x # tl ms⇩1 = n' # nsx'"
and "n' ∈ obs_intra n ⌊HRB_slice S⌋⇘CFG⇙"
from ‹ms⇩1 = nsx @ n # nsx'› ‹x # tl ms⇩1 = n' # nsx'› ‹tl ms⇩2 = tl ms⇩1›
have [simp]:"nsx = []" by(cases nsx) auto
with ‹ms⇩1 = nsx @ n # nsx'› have [simp]:"n = hd ms⇩1" by simp
from ‹x # tl ms⇩1 = n' # nsx'› have [simp]:"n' = x" by simp
with ‹n' ∈ obs_intra n ⌊HRB_slice S⌋⇘CFG⇙› show ?thesis by simp
qed
{ fix m as assume "hd ms⇩1 -as→⇩ι* m"
hence "hd ms⇩1 -as→* m" and "∀a ∈ set as. intra_kind (kind a)"
by(simp_all add:intra_path_def)
hence "m = hd ms⇩1"
proof(induct "hd ms⇩1" as m rule:path.induct)
case (Cons_path m'' as' m' a')
from ‹∀a∈set (a' # as'). intra_kind (kind a)›
have "intra_kind (kind a')" by simp
with ‹valid_edge a› ‹kind a = Q↩⇘p⇙f'› ‹valid_edge a'›
‹sourcenode a' = hd ms⇩1› ‹hd ms⇩1 = sourcenode a›
have False by(fastforce dest:return_edges_only simp:intra_kind_def)
thus ?case by simp
qed simp }
with ‹x ∈ obs_intra (hd ms⇩1) ⌊HRB_slice S⌋⇘CFG⇙›
have "x = hd ms⇩1" by(fastforce elim:obs_intraE)
with ‹x ∈ obs_intra (hd ms⇩2) ⌊HRB_slice S⌋⇘CFG⇙› ‹length ms⇩2 = length s⇩2›
‹∀m∈set (tl ms⇩1). return_node m› ‹ms⇩2 ≠ []›
obtain as where "S,slice_kind S ⊢ (hd ms⇩2#tl ms⇩2,s⇩2) =as⇒⇩τ (hd ms⇩1#tl ms⇩1,s⇩2)"
by(fastforce elim!:silent_moves_intra_path_obs[of _ _ _ s⇩2 "tl ms⇩2"]
dest:hd_Cons_tl)
with ‹ms⇩2 ≠ []› have "S,slice_kind S ⊢ (ms⇩2,s⇩2) =as⇒⇩τ (ms⇩1,s⇩2)"
by(fastforce dest!:hd_Cons_tl)
thus ?thesis by blast
qed
then obtain as where "S,slice_kind S ⊢ (ms⇩2,s⇩2) =as⇒⇩τ (ms⇩1,s⇩2)" by blast
from ‹ms⇩1' = tl ms⇩1› ‹length s⇩1 = Suc(length s⇩1')›
‹length ms⇩1 = length s⇩1› have "length ms⇩1' = length s⇩1'" by simp
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f'› obtain a'' Q' r' fs' where "valid_edge a''"
and "kind a'' = Q':r'↪⇘p⇙fs'" and "a ∈ get_return_edges a''"
by -(drule return_needs_call,auto)
then obtain ins outs where "(p,ins,outs) ∈ set procs"
by(fastforce dest!:callee_in_procs)
from ‹length s⇩1 = Suc(length s⇩1')› ‹s⇩1' ≠ []›
obtain cfx cfsx where [simp]:"cfs⇩1 = cfx#cfsx" by(cases cfs⇩1) auto
with ‹length s⇩1 = length s⇩2› obtain cfx' cfsx' where [simp]:"cfs⇩2 = cfx'#cfsx'"
by(cases cfs⇩2) auto
from ‹length ms⇩1 = length s⇩1› have "tl ms⇩1 = []@hd(tl ms⇩1)#tl(tl ms⇩1)"
by(auto simp:length_Suc_conv)
from ‹kind a = Q↩⇘p⇙f'› ‹transfer (kind a) s⇩1 = s⇩1'›
have "s⇩1' = (f' (fst cf⇩1) (fst cfx),snd cfx)#cfsx" by simp
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f'› ‹(p,ins,outs) ∈ set procs›
have "f' (fst cf⇩1) (fst cfx) =
(fst cfx)(ParamDefs (targetnode a) [:=] map (fst cf⇩1) outs)"
by(rule CFG_return_edge_fun)
with ‹s⇩1' = (f' (fst cf⇩1) (fst cfx),snd cfx)#cfsx›
have [simp]:"s⇩1' =
((fst cfx)(ParamDefs (targetnode a) [:=] map (fst cf⇩1) outs),snd cfx)#cfsx"
by simp
have "pred (slice_kind S a) s⇩2"
proof(cases "sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙")
case True
from ‹valid_edge a› have "valid_node (sourcenode a)" by simp
hence "sourcenode a -[]→⇩ι* sourcenode a"
by(fastforce intro:empty_path simp:intra_path_def)
with ‹sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙›
have "∀V. V ∈ Use⇘SDG⇙ (CFG_node (sourcenode a))
⟶ V ∈ rv S (CFG_node (sourcenode a))"
by auto(rule rvI,auto simp:SDG_to_CFG_set_def sourcenodes_def)
with ‹valid_node (sourcenode a)›
have "∀V ∈ Use (sourcenode a). V ∈ rv S (CFG_node (sourcenode a))"
by(fastforce intro:CFG_Use_SDG_Use)
from ‹∀i < length ms⇩2. ∀V ∈ rv S (CFG_node ((mx#tl ms⇩2)!i)).
(fst (s⇩1!(length msx + i))) V = (fst (s⇩2!i)) V› ‹length ms⇩2 = length s⇩2›
have "∀V∈rv S (CFG_node mx). (fst (s⇩1 ! length msx)) V = state_val s⇩2 V"
by(cases ms⇩2) auto
with ‹∀V ∈ Use (sourcenode a). V ∈ rv S (CFG_node (sourcenode a))›
have "∀V ∈ Use (sourcenode a). fst cf⇩1 V = fst cf⇩2 V" by fastforce
moreover
from ‹∀i<length ms⇩2. snd (s⇩1 ! (length msx + i)) = snd (s⇩2 ! i)›
have "snd (hd s⇩1) = snd (hd s⇩2)" by(erule_tac x="0" in allE) auto
ultimately have "pred (kind a) s⇩2"
using ‹valid_edge a› ‹pred (kind a) s⇩1› ‹length s⇩1 = length s⇩2›
by(fastforce intro:CFG_edge_Uses_pred_equal)
with ‹valid_edge a› ‹kind a = Q↩⇘p⇙f'› ‹(p,ins,outs) ∈ set procs›
‹sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙›
show ?thesis by(fastforce dest:slice_kind_Return_in_slice)
next
case False
with ‹kind a = Q↩⇘p⇙f'› have "slice_kind S a = (λcf. True)↩⇘p⇙(λcf cf'. cf')"
by -(rule slice_kind_Return)
thus ?thesis by simp
qed
from ‹valid_edge a› ‹length s⇩1 = length s⇩2› ‹transfer (kind a) s⇩1 = s⇩1'›
have "length s⇩1' = length (transfer (slice_kind S a) s⇩2)"
by(fastforce intro:length_transfer_kind_slice_kind)
with ‹pred (slice_kind S a) s⇩2› ‹valid_edge a› ‹kind a = Q↩⇘p⇙f'›
‹∀m ∈ set (tl ms⇩1). ∃m'. call_of_return_node m m' ∧ m' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
‹hd ms⇩1 = sourcenode a›
‹length ms⇩1 = length s⇩1› ‹length s⇩1 = length s⇩2›
‹ms⇩1' = tl ms⇩1› ‹hd(tl ms⇩1) = targetnode a› ‹∀m ∈ set (tl ms⇩1). return_node m›
have "S,slice_kind S ⊢ (ms⇩1,s⇩2) -a→ (ms⇩1',transfer (slice_kind S a) s⇩2)"
by(fastforce intro!:observable_move.observable_move_return)
with ‹S,slice_kind S ⊢ (ms⇩2,s⇩2) =as⇒⇩τ (ms⇩1,s⇩2)›
have "S,slice_kind S ⊢ (ms⇩2,s⇩2) =as@[a]⇒ (ms⇩1',transfer (slice_kind S a) s⇩2)"
by(rule observable_moves_snoc)
from ‹∀m ∈ set ms⇩1. valid_node m› ‹ms⇩1' = tl ms⇩1›
have "∀m ∈ set ms⇩1'. valid_node m" by(cases ms⇩1) auto
from ‹length ms⇩1' = length s⇩1'› have "ms⇩1' = []@hd ms⇩1'#tl ms⇩1'"
by(cases ms⇩1') auto
from ‹∀i<length ms⇩2. snd (s⇩1 ! (length msx + i)) = snd (s⇩2 ! i)›
‹length ms⇩1 = length ms⇩2› ‹length ms⇩1 = length s⇩1›
have "snd cfx = snd cfx'" by(erule_tac x="1" in allE) auto
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f'› ‹(p,ins,outs) ∈ set procs›
have cf2':"∃cf⇩2'. transfer (slice_kind S a) s⇩2 = cf⇩2'#cfsx' ∧ snd cf⇩2' = snd cfx'"
by(cases cfx',cases "sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙",
auto dest:slice_kind_Return slice_kind_Return_in_slice)
with ‹∀i<length ms⇩2. snd (s⇩1 ! (length msx + i)) = snd (s⇩2 ! i)›
‹length ms⇩1' = length s⇩1'› ‹msx = []› ‹length ms⇩1 = length ms⇩2›
‹length ms⇩1 = length s⇩1› ‹snd cfx = snd cfx'›
have "∀i<length ms⇩1'. snd (s⇩1' ! i) = snd (transfer (slice_kind S a) s⇩2 ! i)"
apply auto apply(case_tac i) apply auto
by(erule_tac x="Suc(Suc nat)" in allE) auto
from ‹∀m ∈ set (tl ms⇩1). ∃m'. call_of_return_node m m' ∧ m' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
have "∀m ∈ set (tl (tl ms⇩1)).
∃m'. call_of_return_node m m' ∧ m' ∈ ⌊HRB_slice S⌋⇘CFG⇙"
by(cases "tl ms⇩1") auto
from ‹∀m ∈ set (tl ms⇩1). return_node m›
have "∀m ∈ set (tl (tl ms⇩1)). return_node m" by(cases "tl ms⇩1") auto
have "∀V∈rv S (CFG_node (hd (tl ms⇩1))).
(fst cfx)(ParamDefs (targetnode a) [:=] map (fst cf⇩1) outs) V =
state_val (transfer (slice_kind S a) s⇩2) V"
proof
fix V assume "V∈rv S (CFG_node (hd (tl ms⇩1)))"
with ‹hd(tl ms⇩1) = targetnode a› have "V∈rv S (CFG_node (targetnode a))"
by simp
show "(fst cfx)(ParamDefs (targetnode a) [:=] map (fst cf⇩1) outs) V =
state_val (transfer (slice_kind S a) s⇩2) V"
proof(cases "V ∈ set (ParamDefs (targetnode a))")
case True
then obtain i where "V = (ParamDefs (targetnode a))!i"
and "i < length(ParamDefs (targetnode a))"
by(auto simp:in_set_conv_nth)
moreover
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f'› ‹(p,ins,outs) ∈ set procs›
have length:"length(ParamDefs (targetnode a)) = length outs"
by(fastforce intro:ParamDefs_return_target_length)
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f'› ‹(p,ins,outs) ∈ set procs›
‹i < length(ParamDefs (targetnode a))›
‹length(ParamDefs (targetnode a)) = length outs›
have "valid_SDG_node (Actual_out(targetnode a,i))" by fastforce
with ‹V = (ParamDefs (targetnode a))!i›
have "V ∈ Def⇘SDG⇙ (Actual_out(targetnode a,i))"
by(fastforce intro:Actual_out_SDG_Def)
from ‹V ∈ rv S (CFG_node (targetnode a))› obtain as' nx
where "targetnode a -as'→⇩ι* parent_node nx"
and "nx ∈ HRB_slice S" and "V ∈ Use⇘SDG⇙ nx"
and "∀n''. valid_SDG_node n'' ∧
parent_node n'' ∈ set (sourcenodes as') ⟶ V ∉ Def⇘SDG⇙ n''"
by(fastforce elim:rvE)
with ‹valid_SDG_node (Actual_out(targetnode a,i))›
‹V ∈ Def⇘SDG⇙ (Actual_out(targetnode a,i))›
have "targetnode a = parent_node nx"
apply(auto simp:intra_path_def sourcenodes_def)
apply(erule path.cases) apply fastforce
apply(erule_tac x="(Actual_out(targetnode a,i))" in allE) by fastforce
with ‹V ∈ Use⇘SDG⇙ nx› have "V ∈ Use (targetnode a)"
by(fastforce intro:SDG_Use_parent_Use)
with ‹valid_edge a› have "V ∈ Use⇘SDG⇙ (CFG_node (targetnode a))"
by(auto intro!:CFG_Use_SDG_Use)
from ‹targetnode a = parent_node nx›[THEN sym] ‹valid_edge a›
have "parent_node (Actual_out(targetnode a,i)) -[]→⇩ι* parent_node nx"
by(fastforce intro:empty_path simp:intra_path_def)
with ‹V ∈ Def⇘SDG⇙ (Actual_out(targetnode a,i))›
‹V ∈ Use⇘SDG⇙ (CFG_node (targetnode a))› ‹targetnode a = parent_node nx›
have "Actual_out(targetnode a,i) influences V in (CFG_node (targetnode a))"
by(fastforce simp:data_dependence_def sourcenodes_def)
hence ddep:"Actual_out(targetnode a,i) s-V→⇩d⇩d (CFG_node (targetnode a))"
by(rule sum_SDG_ddep_edge)
from ‹targetnode a = parent_node nx› ‹nx ∈ HRB_slice S›
have "CFG_node (targetnode a) ∈ HRB_slice S"
by(fastforce dest:valid_SDG_node_in_slice_parent_node_in_slice)
hence "Actual_out(targetnode a,i) ∈ HRB_slice S"
proof(induct "CFG_node (targetnode a)" rule:HRB_slice_cases)
case (phase1 nx')
with ddep show ?case
by(fastforce intro: ddep_slice1 combine_SDG_slices.combSlice_refl
simp:HRB_slice_def)
next
case (phase2 nx' n' n'' p)
from ‹CFG_node (targetnode a) ∈ sum_SDG_slice2 n'› ddep
have "Actual_out(targetnode a,i) ∈ sum_SDG_slice2 n'"
by(fastforce intro:ddep_slice2)
with ‹n'' s-p→⇘ret⇙ CFG_node (parent_node n')› ‹n' ∈ sum_SDG_slice1 nx'›
‹nx' ∈ S›
show ?case by(fastforce intro:combine_SDG_slices.combSlice_Return_parent_node
simp:HRB_slice_def)
qed
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f'› ‹valid_edge a''›
‹kind a'' = Q':r'↪⇘p⇙fs'› ‹a ∈ get_return_edges a''›
‹CFG_node (targetnode a) ∈ HRB_slice S›
have "CFG_node (sourcenode a) ∈ HRB_slice S"
by(rule call_return_nodes_in_slice)
hence "sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙" by(simp add:SDG_to_CFG_set_def)
from ‹sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙› ‹valid_edge a› ‹kind a = Q↩⇘p⇙f'›
‹(p,ins,outs) ∈ set procs›
have slice_kind:"slice_kind S a =
Q↩⇘p⇙(λcf cf'. rspp (targetnode a) (HRB_slice S) outs cf' cf)"
by(rule slice_kind_Return_in_slice)
from ‹Actual_out(targetnode a,i) ∈ HRB_slice S›
‹i < length(ParamDefs (targetnode a))› ‹valid_edge a›
‹V = (ParamDefs (targetnode a))!i› length
have 2:"rspp (targetnode a) (HRB_slice S) outs (fst cfx') (fst cf⇩2) V =
(fst cf⇩2)(outs!i)"
by(fastforce intro:rspp_Actual_out_in_slice)
from ‹i < length(ParamDefs (targetnode a))› length ‹valid_edge a›
have "(fst cfx)(ParamDefs (targetnode a) [:=] map (fst cf⇩1) outs)
((ParamDefs (targetnode a))!i) = (map (fst cf⇩1) outs)!i"
by(fastforce intro:fun_upds_nth distinct_ParamDefs)
with ‹V = (ParamDefs (targetnode a))!i›
‹i < length(ParamDefs (targetnode a))› length
have 1:"(fst cfx)(ParamDefs (targetnode a) [:=] map (fst cf⇩1) outs) V =
(fst cf⇩1)(outs!i)"
by simp
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f'› ‹(p,ins,outs) ∈ set procs›
‹i < length(ParamDefs (targetnode a))› length
have po:"Formal_out(sourcenode a,i) s-p:outs!i→⇘out⇙ Actual_out(targetnode a,i)"
by(fastforce intro:sum_SDG_param_out_edge)
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f'›
have "CFG_node (sourcenode a) s-p→⇘ret⇙ CFG_node (targetnode a)"
by(fastforce intro:sum_SDG_return_edge)
from ‹Actual_out(targetnode a,i) ∈ HRB_slice S›
have "Formal_out(sourcenode a,i) ∈ HRB_slice S"
proof(induct "Actual_out(targetnode a,i)" rule:HRB_slice_cases)
case (phase1 nx')
let ?AO = "Actual_out(targetnode a,i)"
from ‹valid_SDG_node ?AO› have "?AO ∈ sum_SDG_slice2 ?AO"
by(rule refl_slice2)
with po have "Formal_out(sourcenode a,i) ∈ sum_SDG_slice2 ?AO"
by(rule param_out_slice2)
with ‹CFG_node (sourcenode a) s-p→⇘ret⇙ CFG_node (targetnode a)›
‹Actual_out (targetnode a, i) ∈ sum_SDG_slice1 nx'› ‹nx' ∈ S›
show ?case
by(fastforce intro:combSlice_Return_parent_node simp:HRB_slice_def)
next
case (phase2 nx' n' n'' p)
from ‹Actual_out (targetnode a, i) ∈ sum_SDG_slice2 n'› po
have "Formal_out(sourcenode a,i) ∈ sum_SDG_slice2 n'"
by(fastforce intro:param_out_slice2)
with ‹n' ∈ sum_SDG_slice1 nx'› ‹n'' s-p→⇘ret⇙ CFG_node (parent_node n')›
‹nx' ∈ S›
show ?case by(fastforce intro:combine_SDG_slices.combSlice_Return_parent_node
simp:HRB_slice_def)
qed
with ‹valid_edge a› ‹kind a = Q↩⇘p⇙f'› ‹(p,ins,outs) ∈ set procs›
‹i < length(ParamDefs (targetnode a))› length
have "outs!i ∈ Use⇘SDG⇙ Formal_out(sourcenode a,i)"
by(fastforce intro!:Formal_out_SDG_Use get_proc_return)
with ‹valid_edge a› have "outs!i ∈ Use⇘SDG⇙ (CFG_node (sourcenode a))"
by(auto intro!:CFG_Use_SDG_Use dest:SDG_Use_parent_Use)
moreover
from ‹valid_edge a› have "parent_node (CFG_node (sourcenode a)) -[]→⇩ι*
parent_node (CFG_node (sourcenode a))"
by(fastforce intro:empty_path simp:intra_path_def)
ultimately have "outs!i ∈ rv S (CFG_node (sourcenode a))"
using ‹sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙› ‹valid_edge a›
by(fastforce intro:rvI simp:SDG_to_CFG_set_def sourcenodes_def)
with ‹∀i < length ms⇩2. ∀V ∈ rv S (CFG_node ((mx#tl ms⇩2)!i)).
(fst (s⇩1!(length msx + i))) V = (fst (s⇩2!i)) V›
have "(fst cf⇩1)(outs!i) = (fst cf⇩2)(outs!i)"
by auto(erule_tac x="0" in allE,auto)
with 1 2 slice_kind show ?thesis by simp
next
case False
with ‹transfer (kind a) s⇩1 = s⇩1'›
have "(fst cfx)(ParamDefs (targetnode a) [:=] map (fst cf⇩1) outs) =
(fst (hd cfs⇩1))(ParamDefs (targetnode a) [:=] map (fst cf⇩1) outs)"
by(cases cfs⇩1,auto intro:CFG_return_edge_fun)
show ?thesis
proof(cases "sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙")
case True
from ‹sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙› ‹valid_edge a› ‹kind a = Q↩⇘p⇙f'›
‹(p,ins,outs) ∈ set procs›
have "slice_kind S a =
Q↩⇘p⇙(λcf cf'. rspp (targetnode a) (HRB_slice S) outs cf' cf)"
by(rule slice_kind_Return_in_slice)
with ‹length s⇩1' = length (transfer (slice_kind S a) s⇩2)›
‹length s⇩1 = length s⇩2›
have "state_val (transfer (slice_kind S a) s⇩2) V =
rspp (targetnode a) (HRB_slice S) outs (fst cfx') (fst cf⇩2) V"
by simp
with ‹V ∉ set (ParamDefs (targetnode a))›
have "state_val (transfer (slice_kind S a) s⇩2) V = state_val cfs⇩2 V"
by(fastforce simp:rspp_def map_merge_def)
with ‹∀i < length ms⇩2. ∀V ∈ rv S (CFG_node ((mx#tl ms⇩2)!i)).
(fst (s⇩1!(length msx + i))) V = (fst (s⇩2!i)) V›
‹hd(tl ms⇩1) = targetnode a›
‹length ms⇩1 = length s⇩1› ‹length s⇩1 = length s⇩2›[THEN sym] False
‹tl ms⇩2 = tl ms⇩1› ‹length ms⇩2 = length s⇩2›
‹V∈rv S (CFG_node (targetnode a))›
show ?thesis by(fastforce simp:length_Suc_conv fun_upds_notin)
next
case False
from ‹sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙› ‹kind a = Q↩⇘p⇙f'›
have "slice_kind S a = (λcf. True)↩⇘p⇙(λcf cf'. cf')"
by(rule slice_kind_Return)
from ‹length ms⇩2 = length s⇩2› have "1 < length ms⇩2" by simp
with ‹∀i < length ms⇩2. ∀V ∈ rv S (CFG_node ((mx#tl ms⇩2)!i)).
(fst (s⇩1!(length msx + i))) V = (fst (s⇩2!i)) V›
‹V∈rv S (CFG_node (hd (tl ms⇩1)))›
‹ms⇩1' = tl ms⇩1› ‹ms⇩1' = []@hd ms⇩1'#tl ms⇩1'›
have "fst cfx V = fst cfx' V" apply auto
apply(erule_tac x="1" in allE)
by(cases "tl ms⇩1") auto
with ‹∀i < length ms⇩2. ∀V ∈ rv S (CFG_node ((mx#tl ms⇩2)!i)).
(fst (s⇩1!(length msx + i))) V = (fst (s⇩2!i)) V›
‹hd(tl ms⇩1) = targetnode a›
‹length ms⇩1 = length s⇩1› ‹length s⇩1 = length s⇩2›[THEN sym] False
‹tl ms⇩2 = tl ms⇩1› ‹length ms⇩2 = length s⇩2›
‹V∈rv S (CFG_node (targetnode a))›
‹V ∉ set (ParamDefs (targetnode a))›
‹slice_kind S a = (λcf. True)↩⇘p⇙(λcf cf'. cf')›
show ?thesis by(auto simp:fun_upds_notin)
qed
qed
qed
with ‹hd(tl ms⇩1) = targetnode a› ‹tl ms⇩2 = tl ms⇩1› ‹ms⇩1' = tl ms⇩1›
‹∀i < length ms⇩2. ∀V ∈ rv S (CFG_node ((mx#tl ms⇩2)!i)).
(fst (s⇩1!(length msx + i))) V = (fst (s⇩2!i)) V› ‹length ms⇩1' = length s⇩1'›
‹length ms⇩1 = length s⇩1› ‹length ms⇩2 = length s⇩2› ‹length s⇩1 = length s⇩2› cf2'
have "∀i<length ms⇩1'. ∀V∈rv S (CFG_node ((hd (tl ms⇩1) # tl ms⇩1')!i)).
(fst (s⇩1'!(length [] + i))) V = (fst (transfer (slice_kind S a) s⇩2!i)) V"
apply(case_tac "tl ms⇩1") apply auto
apply(cases ms⇩2) apply auto
apply(case_tac i) apply auto
by(erule_tac x="Suc(Suc nat)" in allE,auto)
with ‹∀m ∈ set ms⇩2. valid_node m› ‹∀m ∈ set ms⇩1'. valid_node m›
‹length ms⇩2 = length s⇩2› ‹length s⇩1' = length (transfer (slice_kind S a) s⇩2)›
‹length ms⇩1' = length s⇩1'› ‹ms⇩1' = tl ms⇩1› ‹ms⇩1' = []@hd ms⇩1'#tl ms⇩1'›
‹tl ms⇩1 = []@hd(tl ms⇩1)#tl(tl ms⇩1)›
‹get_proc mx = get_proc (hd ms⇩2)›
‹∀m ∈ set (tl (tl ms⇩1)). ∃m'. call_of_return_node m m' ∧ m' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
‹∀m ∈ set (tl (tl ms⇩1)). return_node m›
‹∀i<length ms⇩1'. snd (s⇩1' ! i) = snd (transfer (slice_kind S a) s⇩2 ! i)›
have "((ms⇩1',s⇩1'),(ms⇩1',transfer (slice_kind S a) s⇩2)) ∈ WS S"
by(auto intro!:WSI)
with ‹S,slice_kind S ⊢ (ms⇩2,s⇩2) =as@[a]⇒ (ms⇩1',transfer (slice_kind S a) s⇩2)›
show ?case by blast
qed
qed
subsection ‹The weak simulation›
definition is_weak_sim ::
"(('node list × (('var ⇀ 'val) × 'ret) list) ×
('node list × (('var ⇀ 'val) × 'ret) list)) set ⇒ 'node SDG_node set ⇒ bool"
where "is_weak_sim R S ≡
∀ms⇩1 s⇩1 ms⇩2 s⇩2 ms⇩1' s⇩1' as.
((ms⇩1,s⇩1),(ms⇩2,s⇩2)) ∈ R ∧ S,kind ⊢ (ms⇩1,s⇩1) =as⇒ (ms⇩1',s⇩1') ∧ s⇩1' ≠ []
⟶ (∃ms⇩2' s⇩2' as'. ((ms⇩1',s⇩1'),(ms⇩2',s⇩2')) ∈ R ∧
S,slice_kind S ⊢ (ms⇩2,s⇩2) =as'⇒ (ms⇩2',s⇩2'))"
lemma WS_weak_sim:
assumes "((ms⇩1,s⇩1),(ms⇩2,s⇩2)) ∈ WS S"
and "S,kind ⊢ (ms⇩1,s⇩1) =as⇒ (ms⇩1',s⇩1')" and "s⇩1' ≠ []"
obtains as' where "((ms⇩1',s⇩1'),(ms⇩1',transfer (slice_kind S (last as)) s⇩2)) ∈ WS S"
and "S,slice_kind S ⊢ (ms⇩2,s⇩2) =as'@[last as]⇒
(ms⇩1',transfer (slice_kind S (last as)) s⇩2)"
proof(atomize_elim)
from ‹S,kind ⊢ (ms⇩1,s⇩1) =as⇒ (ms⇩1',s⇩1')› obtain ms' s' as' a'
where "S,kind ⊢ (ms⇩1,s⇩1) =as'⇒⇩τ (ms',s')"
and "S,kind ⊢ (ms',s') -a'→ (ms⇩1',s⇩1')" and "as = as'@[a']"
by(fastforce elim:observable_moves.cases)
from ‹S,kind ⊢ (ms',s') -a'→ (ms⇩1',s⇩1')›
have "∀m ∈ set (tl ms'). ∃m'. call_of_return_node m m' ∧ m' ∈ ⌊HRB_slice S⌋⇘CFG⇙"
and "∀n ∈ set (tl ms'). return_node n" and "ms' ≠ []"
by(auto elim:observable_move.cases simp:call_of_return_node_def)
from ‹S,kind ⊢ (ms⇩1,s⇩1) =as'⇒⇩τ (ms',s')› ‹((ms⇩1,s⇩1),(ms⇩2,s⇩2)) ∈ WS S›
have "((ms',s'),(ms⇩2,s⇩2)) ∈ WS S" by(rule WS_silent_moves)
with ‹S,kind ⊢ (ms',s') -a'→ (ms⇩1',s⇩1')› ‹s⇩1' ≠ []›
obtain as'' where "((ms⇩1',s⇩1'),(ms⇩1',transfer (slice_kind S a') s⇩2)) ∈ WS S"
and "S,slice_kind S ⊢ (ms⇩2,s⇩2) =as''@[a']⇒
(ms⇩1',transfer (slice_kind S a') s⇩2)"
by(fastforce elim:WS_observable_move)
with ‹((ms⇩1',s⇩1'),(ms⇩1',transfer (slice_kind S a') s⇩2)) ∈ WS S› ‹as = as'@[a']›
show "∃as'. ((ms⇩1',s⇩1'),(ms⇩1',transfer (slice_kind S (last as)) s⇩2)) ∈ WS S ∧
S,slice_kind S ⊢ (ms⇩2,s⇩2) =as'@[last as]⇒
(ms⇩1',transfer (slice_kind S (last as)) s⇩2)"
by fastforce
qed
text ‹The following lemma states the correctness of static intraprocedural slicing:\\
the simulation ‹WS S› is a desired weak simulation›
theorem WS_is_weak_sim:"is_weak_sim (WS S) S"
by(fastforce elim:WS_weak_sim simp:is_weak_sim_def)
end
end
Theory FundamentalProperty
section ‹The fundamental property of slicing›
theory FundamentalProperty imports WeakSimulation SemanticsCFG begin
context SDG begin
subsection ‹Auxiliary lemmas for moves in the graph›
lemma observable_set_stack_in_slice:
"S,f ⊢ (ms,s) -a→ (ms',s')
⟹ ∀mx ∈ set (tl ms'). ∃mx'. call_of_return_node mx mx' ∧ mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙"
proof(induct rule:observable_move.induct)
case (observable_move_intra f a s s' ms S ms') thus ?case by simp
next
case (observable_move_call f a s s' Q r p fs a' ms S ms')
from ‹valid_edge a› ‹valid_edge a'› ‹a' ∈ get_return_edges a›
have "call_of_return_node (targetnode a') (sourcenode a)"
by(fastforce simp:return_node_def call_of_return_node_def)
with ‹hd ms = sourcenode a› ‹hd ms ∈ ⌊HRB_slice S⌋⇘CFG⇙›
‹ms' = targetnode a # targetnode a' # tl ms›
‹∀mx∈set (tl ms). ∃mx'. call_of_return_node mx mx' ∧ mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
show ?case by fastforce
next
case (observable_move_return f a s s' Q p f' ms S ms')
thus ?case by(cases "tl ms") auto
qed
lemma silent_move_preserves_stacks:
assumes "S,f ⊢ (m#ms,s) -a→⇩τ (m'#ms',s')" and "valid_call_list cs m"
and "∀i < length rs. rs!i ∈ get_return_edges (cs!i)" and "valid_return_list rs m"
and "length rs = length cs" and "ms = targetnodes rs"
obtains cs' rs' where "valid_node m'" and "valid_call_list cs' m'"
and "∀i < length rs'. rs'!i ∈ get_return_edges (cs'!i)"
and "valid_return_list rs' m'" and "length rs' = length cs'"
and "ms' = targetnodes rs'" and "upd_cs cs [a] = cs'"
proof(atomize_elim)
from assms show "∃cs' rs'. valid_node m' ∧ valid_call_list cs' m' ∧
(∀i<length rs'. rs' ! i ∈ get_return_edges (cs' ! i)) ∧
valid_return_list rs' m' ∧ length rs' = length cs' ∧ ms' = targetnodes rs' ∧
upd_cs cs [a] = cs'"
proof(induct S f "m#ms" s a "m'#ms'" s' rule:silent_move.induct)
case (silent_move_intra f a s s' n⇩c)
from ‹hd (m # ms) = sourcenode a› have "m = sourcenode a" by simp
from ‹m' # ms' = targetnode a # tl (m # ms)›
have [simp]:"m' = targetnode a" "ms' = ms" by simp_all
from ‹valid_edge a› have "valid_node m'" by simp
moreover
from ‹valid_edge a› ‹intra_kind (kind a)›
have "get_proc (sourcenode a) = get_proc (targetnode a)" by(rule get_proc_intra)
from ‹valid_call_list cs m› ‹m = sourcenode a›
‹get_proc (sourcenode a) = get_proc (targetnode a)›
have "valid_call_list cs m'"
apply(clarsimp simp:valid_call_list_def)
apply(erule_tac x="cs'" in allE)
apply(erule_tac x="c" in allE)
by(auto split:list.split)
moreover
from ‹valid_return_list rs m› ‹m = sourcenode a›
‹get_proc (sourcenode a) = get_proc (targetnode a)›
have "valid_return_list rs m'"
apply(clarsimp simp:valid_return_list_def)
apply(erule_tac x="cs'" in allE) apply clarsimp
by(case_tac cs') auto
moreover
from ‹intra_kind (kind a)› have "upd_cs cs [a] = cs"
by(fastforce simp:intra_kind_def)
ultimately show ?case using ‹∀i<length rs. rs ! i ∈ get_return_edges (cs ! i)›
‹length rs = length cs› ‹ms = targetnodes rs›
apply(rule_tac x="cs" in exI)
apply(rule_tac x="rs" in exI)
by clarsimp
next
case (silent_move_call f a s s' Q r p fs a' S)
from ‹hd (m # ms) = sourcenode a›
‹m' # ms' = targetnode a # targetnode a' # tl (m # ms)›
have [simp]:"m = sourcenode a" "m' = targetnode a"
"ms' = targetnode a' # tl (m # ms)"
by simp_all
from ‹valid_edge a› have "valid_node m'" by simp
moreover
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› have "get_proc (targetnode a) = p"
by(rule get_proc_call)
with ‹valid_call_list cs m› ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹m = sourcenode a›
have "valid_call_list (a # cs) (targetnode a)"
apply(clarsimp simp:valid_call_list_def)
apply(case_tac cs') apply auto
apply(erule_tac x="list" in allE)
by(case_tac list)(auto simp:sourcenodes_def)
moreover
from ‹∀i<length rs. rs ! i ∈ get_return_edges (cs ! i)› ‹a' ∈ get_return_edges a›
have "∀i<length (a'#rs). (a'#rs) ! i ∈ get_return_edges ((a#cs) ! i)"
by auto(case_tac i,auto)
moreover
from ‹valid_edge a› ‹a' ∈ get_return_edges a› have "valid_edge a'"
by(rule get_return_edges_valid)
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹a' ∈ get_return_edges a›
obtain Q' f' where "kind a' = Q'↩⇘p⇙f'" by(fastforce dest!:call_return_edges)
from ‹valid_edge a'› ‹kind a' = Q'↩⇘p⇙f'› have "get_proc (sourcenode a') = p"
by(rule get_proc_return)
from ‹valid_edge a› ‹a' ∈ get_return_edges a›
have "get_proc (sourcenode a) = get_proc (targetnode a')"
by(rule get_proc_get_return_edge)
with ‹valid_return_list rs m› ‹valid_edge a'› ‹kind a' = Q'↩⇘p⇙f'›
‹get_proc (sourcenode a') = p› ‹get_proc (targetnode a) = p› ‹m = sourcenode a›
have "valid_return_list (a'#rs) (targetnode a)"
apply(clarsimp simp:valid_return_list_def)
apply(case_tac cs') apply auto
apply(erule_tac x="list" in allE)
by(case_tac list)(auto simp:targetnodes_def)
moreover
from ‹length rs = length cs› have "length (a'#rs) = length (a#cs)" by simp
moreover
from ‹ms = targetnodes rs› have "targetnode a' # ms = targetnodes (a' # rs)"
by(simp add:targetnodes_def)
moreover
from ‹kind a = Q:r↪⇘p⇙fs› have "upd_cs cs [a] = a#cs" by simp
ultimately show ?case
apply(rule_tac x="a#cs" in exI)
apply(rule_tac x="a'#rs" in exI)
by clarsimp
next
case (silent_move_return f a s s' Q p f' S)
from ‹hd (m # ms) = sourcenode a›
‹hd (tl (m # ms)) = targetnode a› ‹m' # ms' = tl (m # ms)› [symmetric]
have [simp]:"m = sourcenode a" "m' = targetnode a" by simp_all
from ‹length (m # ms) = length s› ‹length s = Suc (length s')› ‹s' ≠ []›
‹hd (tl (m # ms)) = targetnode a› ‹m' # ms' = tl (m # ms)›
have "ms = targetnode a # ms'"
by(cases ms) auto
with ‹ms = targetnodes rs›
obtain r' rs' where "rs = r' # rs'"
and "targetnode a = targetnode r'" and "ms' = targetnodes rs'"
by(cases rs)(auto simp:targetnodes_def)
moreover
from ‹rs = r' # rs'› ‹length rs = length cs› obtain c' cs' where "cs = c' # cs'"
and "length rs' = length cs'" by(cases cs) auto
moreover
from ‹∀i<length rs. rs ! i ∈ get_return_edges (cs ! i)›
‹rs = r' # rs'› ‹cs = c' # cs'›
have "∀i<length rs'. rs' ! i ∈ get_return_edges (cs' ! i)"
and "r' ∈ get_return_edges c'" by auto
moreover
from ‹valid_edge a› have "valid_node (targetnode a)" by simp
moreover
from ‹valid_call_list cs m› ‹cs = c' # cs'›
obtain p' Q' r fs' where "valid_edge c'" and "kind c' = Q':r↪⇘p'⇙fs'"
and "p' = get_proc m"
apply(auto simp:valid_call_list_def)
by(erule_tac x="[]" in allE) auto
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f'›
have "get_proc (sourcenode a) = p" by(rule get_proc_return)
with ‹p' = get_proc m› have [simp]:"p' = p" by simp
from ‹valid_edge c'› ‹kind c' = Q':r↪⇘p'⇙fs'›
have "get_proc (targetnode c') = p" by(fastforce intro:get_proc_call)
from ‹valid_edge c'› ‹r' ∈ get_return_edges c'› have "valid_edge r'"
by(rule get_return_edges_valid)
from ‹valid_edge c'› ‹kind c' = Q':r↪⇘p'⇙fs'› ‹r' ∈ get_return_edges c'›
obtain Q'' f'' where "kind r' = Q''↩⇘p⇙f''" by(fastforce dest!:call_return_edges)
with ‹valid_edge r'› have "get_proc (sourcenode r') = p" by(rule get_proc_return)
from ‹valid_edge r'› ‹kind r' = Q''↩⇘p⇙f''› have "method_exit (sourcenode r')"
by(fastforce simp:method_exit_def)
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f'› have "method_exit (sourcenode a)"
by(fastforce simp:method_exit_def)
with ‹method_exit (sourcenode r')› ‹get_proc (sourcenode r') = p›
‹get_proc (sourcenode a) = p›
have "sourcenode a = sourcenode r'" by(fastforce intro:method_exit_unique)
with ‹valid_edge a› ‹valid_edge r'› ‹targetnode a = targetnode r'›
have "a = r'" by(fastforce intro:edge_det)
from ‹valid_edge c'› ‹r' ∈ get_return_edges c'› ‹targetnode a = targetnode r'›
have "get_proc (sourcenode c') = get_proc (targetnode a)"
by(fastforce intro:get_proc_get_return_edge)
from ‹valid_call_list cs m› ‹cs = c' # cs'›
‹get_proc (sourcenode c') = get_proc (targetnode a)›
have "valid_call_list cs' (targetnode a)"
apply(clarsimp simp:valid_call_list_def)
apply(hypsubst_thin)
apply(erule_tac x="c' # cs'" in allE)
by(case_tac cs')(auto simp:sourcenodes_def)
moreover
from ‹valid_return_list rs m› ‹rs = r' # rs'› ‹targetnode a = targetnode r'›
have "valid_return_list rs' (targetnode a)"
apply(clarsimp simp:valid_return_list_def)
apply(erule_tac x="r' # cs'" in allE)
by(case_tac cs')(auto simp:targetnodes_def)
moreover
from ‹kind a = Q↩⇘p⇙f'› ‹cs = c' # cs'› have "upd_cs cs [a] = cs'" by simp
ultimately show ?case
apply(rule_tac x="cs'" in exI)
apply(rule_tac x="rs'" in exI)
by clarsimp
qed
qed
lemma silent_moves_preserves_stacks:
assumes "S,f ⊢ (m#ms,s) =as⇒⇩τ (m'#ms',s')"
and "valid_node m" and "valid_call_list cs m"
and "∀i < length rs. rs!i ∈ get_return_edges (cs!i)" and "valid_return_list rs m"
and "length rs = length cs" and "ms = targetnodes rs"
obtains cs' rs' where "valid_node m'" and "valid_call_list cs' m'"
and "∀i < length rs'. rs'!i ∈ get_return_edges (cs'!i)"
and "valid_return_list rs' m'" and "length rs' = length cs'"
and "ms' = targetnodes rs'" and "upd_cs cs as = cs'"
proof(atomize_elim)
from assms show "∃cs' rs'. valid_node m' ∧ valid_call_list cs' m' ∧
(∀i<length rs'. rs' ! i ∈ get_return_edges (cs' ! i)) ∧
valid_return_list rs' m' ∧ length rs' = length cs' ∧ ms' = targetnodes rs' ∧
upd_cs cs as = cs'"
proof(induct S f "m#ms" s as "m'#ms'" s'
arbitrary:m ms cs rs rule:silent_moves.induct)
case (silent_moves_Nil s n⇩c f)
thus ?case
apply(rule_tac x="cs" in exI)
apply(rule_tac x="rs" in exI)
by clarsimp
next
case (silent_moves_Cons S f s a msx'' s'' as sx')
note IH = ‹⋀m ms cs rs. ⟦msx'' = m # ms; valid_node m; valid_call_list cs m;
∀i<length rs. rs ! i ∈ get_return_edges (cs ! i);
valid_return_list rs m; length rs = length cs; ms = targetnodes rs⟧
⟹ ∃cs' rs'. valid_node m' ∧ valid_call_list cs' m' ∧
(∀i<length rs'. rs' ! i ∈ get_return_edges (cs' ! i)) ∧
valid_return_list rs' m' ∧ length rs' = length cs' ∧ ms' = targetnodes rs' ∧
upd_cs cs as = cs'›
from ‹S,f ⊢ (m # ms,s) -a→⇩τ (msx'',s'')›
obtain m'' ms'' where "msx'' = m''#ms''"
by(cases msx'')(auto elim:silent_move.cases)
with ‹S,f ⊢ (m # ms,s) -a→⇩τ (msx'',s'')› ‹valid_call_list cs m›
‹∀i<length rs. rs ! i ∈ get_return_edges (cs ! i)› ‹valid_return_list rs m›
‹length rs = length cs› ‹ms = targetnodes rs›
obtain cs'' rs'' where hyps:"valid_node m''" "valid_call_list cs'' m''"
"∀i < length rs''. rs''!i ∈ get_return_edges (cs''!i)"
"valid_return_list rs'' m''" "length rs'' = length cs''"
"ms'' = targetnodes rs''" and "upd_cs cs [a] = cs''"
by(auto elim!:silent_move_preserves_stacks)
from IH[OF _ hyps] ‹msx'' = m'' # ms''›
obtain cs' rs' where results:"valid_node m'" "valid_call_list cs' m'"
"∀i<length rs'. rs' ! i ∈ get_return_edges (cs' ! i)"
"valid_return_list rs' m'" "length rs' = length cs'" "ms' = targetnodes rs'"
and "upd_cs cs'' as = cs'" by blast
from ‹upd_cs cs [a] = cs''› ‹upd_cs cs'' as = cs'›
have "upd_cs cs ([a] @ as) = cs'" by(rule upd_cs_Append)
with results show ?case
apply(rule_tac x="cs'" in exI)
apply(rule_tac x="rs'" in exI)
by clarsimp
qed
qed
lemma observable_move_preserves_stacks:
assumes "S,f ⊢ (m#ms,s) -a→ (m'#ms',s')" and "valid_call_list cs m"
and "∀i < length rs. rs!i ∈ get_return_edges (cs!i)" and "valid_return_list rs m"
and "length rs = length cs" and "ms = targetnodes rs"
obtains cs' rs' where "valid_node m'" and "valid_call_list cs' m'"
and "∀i < length rs'. rs'!i ∈ get_return_edges (cs'!i)"
and "valid_return_list rs' m'" and "length rs' = length cs'"
and "ms' = targetnodes rs'" and "upd_cs cs [a] = cs'"
proof(atomize_elim)
from assms show "∃cs' rs'. valid_node m' ∧ valid_call_list cs' m' ∧
(∀i<length rs'. rs' ! i ∈ get_return_edges (cs' ! i)) ∧
valid_return_list rs' m' ∧ length rs' = length cs' ∧ ms' = targetnodes rs' ∧
upd_cs cs [a] = cs'"
proof(induct S f "m#ms" s a "m'#ms'" s' rule:observable_move.induct)
case (observable_move_intra f a s s' n⇩c)
from ‹hd (m # ms) = sourcenode a› have "m = sourcenode a" by simp
from ‹m' # ms' = targetnode a # tl (m # ms)›
have [simp]:"m' = targetnode a" "ms' = ms" by simp_all
from ‹valid_edge a› have "valid_node m'" by simp
moreover
from ‹valid_edge a› ‹intra_kind (kind a)›
have "get_proc (sourcenode a) = get_proc (targetnode a)" by(rule get_proc_intra)
from ‹valid_call_list cs m› ‹m = sourcenode a›
‹get_proc (sourcenode a) = get_proc (targetnode a)›
have "valid_call_list cs m'"
apply(clarsimp simp:valid_call_list_def)
apply(erule_tac x="cs'" in allE)
apply(erule_tac x="c" in allE)
by(auto split:list.split)
moreover
from ‹valid_return_list rs m› ‹m = sourcenode a›
‹get_proc (sourcenode a) = get_proc (targetnode a)›
have "valid_return_list rs m'"
apply(clarsimp simp:valid_return_list_def)
apply(erule_tac x="cs'" in allE) apply clarsimp
by(case_tac cs') auto
moreover
from ‹intra_kind (kind a)› have "upd_cs cs [a] = cs"
by(fastforce simp:intra_kind_def)
ultimately show ?case using ‹∀i<length rs. rs ! i ∈ get_return_edges (cs ! i)›
‹length rs = length cs› ‹ms = targetnodes rs›
apply(rule_tac x="cs" in exI)
apply(rule_tac x="rs" in exI)
by clarsimp
next
case (observable_move_call f a s s' Q r p fs a' S)
from ‹hd (m # ms) = sourcenode a›
‹m' # ms' = targetnode a # targetnode a' # tl (m # ms)›
have [simp]:"m = sourcenode a" "m' = targetnode a"
"ms' = targetnode a' # tl (m # ms)"
by simp_all
from ‹valid_edge a› have "valid_node m'" by simp
moreover
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› have "get_proc (targetnode a) = p"
by(rule get_proc_call)
with ‹valid_call_list cs m› ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹m = sourcenode a›
have "valid_call_list (a # cs) (targetnode a)"
apply(clarsimp simp:valid_call_list_def)
apply(case_tac cs') apply auto
apply(erule_tac x="list" in allE)
by(case_tac list)(auto simp:sourcenodes_def)
moreover
from ‹∀i<length rs. rs ! i ∈ get_return_edges (cs ! i)› ‹a' ∈ get_return_edges a›
have "∀i<length (a'#rs). (a'#rs) ! i ∈ get_return_edges ((a#cs) ! i)"
by auto(case_tac i,auto)
moreover
from ‹valid_edge a› ‹a' ∈ get_return_edges a› have "valid_edge a'"
by(rule get_return_edges_valid)
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹a' ∈ get_return_edges a›
obtain Q' f' where "kind a' = Q'↩⇘p⇙f'" by(fastforce dest!:call_return_edges)
from ‹valid_edge a'› ‹kind a' = Q'↩⇘p⇙f'› have "get_proc (sourcenode a') = p"
by(rule get_proc_return)
from ‹valid_edge a› ‹a' ∈ get_return_edges a›
have "get_proc (sourcenode a) = get_proc (targetnode a')"
by(rule get_proc_get_return_edge)
with ‹valid_return_list rs m› ‹valid_edge a'› ‹kind a' = Q'↩⇘p⇙f'›
‹get_proc (sourcenode a') = p› ‹get_proc (targetnode a) = p› ‹m = sourcenode a›
have "valid_return_list (a'#rs) (targetnode a)"
apply(clarsimp simp:valid_return_list_def)
apply(case_tac cs') apply auto
apply(erule_tac x="list" in allE)
by(case_tac list)(auto simp:targetnodes_def)
moreover
from ‹length rs = length cs› have "length (a'#rs) = length (a#cs)" by simp
moreover
from ‹ms = targetnodes rs› have "targetnode a' # ms = targetnodes (a' # rs)"
by(simp add:targetnodes_def)
moreover
from ‹kind a = Q:r↪⇘p⇙fs› have "upd_cs cs [a] = a#cs" by simp
ultimately show ?case
apply(rule_tac x="a#cs" in exI)
apply(rule_tac x="a'#rs" in exI)
by clarsimp
next
case (observable_move_return f a s s' Q p f' S)
from ‹hd (m # ms) = sourcenode a›
‹hd (tl (m # ms)) = targetnode a› ‹m' # ms' = tl (m # ms)› [symmetric]
have [simp]:"m = sourcenode a" "m' = targetnode a" by simp_all
from ‹length (m # ms) = length s› ‹length s = Suc (length s')› ‹s' ≠ []›
‹hd (tl (m # ms)) = targetnode a› ‹m' # ms' = tl (m # ms)›
have "ms = targetnode a # ms'"
by(cases ms) auto
with ‹ms = targetnodes rs›
obtain r' rs' where "rs = r' # rs'"
and "targetnode a = targetnode r'" and "ms' = targetnodes rs'"
by(cases rs)(auto simp:targetnodes_def)
moreover
from ‹rs = r' # rs'› ‹length rs = length cs› obtain c' cs' where "cs = c' # cs'"
and "length rs' = length cs'" by(cases cs) auto
moreover
from ‹∀i<length rs. rs ! i ∈ get_return_edges (cs ! i)›
‹rs = r' # rs'› ‹cs = c' # cs'›
have "∀i<length rs'. rs' ! i ∈ get_return_edges (cs' ! i)"
and "r' ∈ get_return_edges c'" by auto
moreover
from ‹valid_edge a› have "valid_node (targetnode a)" by simp
moreover
from ‹valid_call_list cs m› ‹cs = c' # cs'›
obtain p' Q' r fs' where "valid_edge c'" and "kind c' = Q':r↪⇘p'⇙fs'"
and "p' = get_proc m"
apply(auto simp:valid_call_list_def)
by(erule_tac x="[]" in allE) auto
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f'›
have "get_proc (sourcenode a) = p" by(rule get_proc_return)
with ‹p' = get_proc m› have [simp]:"p' = p" by simp
from ‹valid_edge c'› ‹kind c' = Q':r↪⇘p'⇙fs'›
have "get_proc (targetnode c') = p" by(fastforce intro:get_proc_call)
from ‹valid_edge c'› ‹r' ∈ get_return_edges c'› have "valid_edge r'"
by(rule get_return_edges_valid)
from ‹valid_edge c'› ‹kind c' = Q':r↪⇘p'⇙fs'› ‹r' ∈ get_return_edges c'›
obtain Q'' f'' where "kind r' = Q''↩⇘p⇙f''" by(fastforce dest!:call_return_edges)
with ‹valid_edge r'› have "get_proc (sourcenode r') = p" by(rule get_proc_return)
from ‹valid_edge r'› ‹kind r' = Q''↩⇘p⇙f''› have "method_exit (sourcenode r')"
by(fastforce simp:method_exit_def)
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f'› have "method_exit (sourcenode a)"
by(fastforce simp:method_exit_def)
with ‹method_exit (sourcenode r')› ‹get_proc (sourcenode r') = p›
‹get_proc (sourcenode a) = p›
have "sourcenode a = sourcenode r'" by(fastforce intro:method_exit_unique)
with ‹valid_edge a› ‹valid_edge r'› ‹targetnode a = targetnode r'›
have "a = r'" by(fastforce intro:edge_det)
from ‹valid_edge c'› ‹r' ∈ get_return_edges c'› ‹targetnode a = targetnode r'›
have "get_proc (sourcenode c') = get_proc (targetnode a)"
by(fastforce intro:get_proc_get_return_edge)
from ‹valid_call_list cs m› ‹cs = c' # cs'›
‹get_proc (sourcenode c') = get_proc (targetnode a)›
have "valid_call_list cs' (targetnode a)"
apply(clarsimp simp:valid_call_list_def)
apply(hypsubst_thin)
apply(erule_tac x="c' # cs'" in allE)
by(case_tac cs')(auto simp:sourcenodes_def)
moreover
from ‹valid_return_list rs m› ‹rs = r' # rs'› ‹targetnode a = targetnode r'›
have "valid_return_list rs' (targetnode a)"
apply(clarsimp simp:valid_return_list_def)
apply(erule_tac x="r' # cs'" in allE)
by(case_tac cs')(auto simp:targetnodes_def)
moreover
from ‹kind a = Q↩⇘p⇙f'› ‹cs = c' # cs'› have "upd_cs cs [a] = cs'" by simp
ultimately show ?case
apply(rule_tac x="cs'" in exI)
apply(rule_tac x="rs'" in exI)
by clarsimp
qed
qed
lemma observable_moves_preserves_stack:
assumes "S,f ⊢ (m#ms,s) =as⇒ (m'#ms',s')"
and "valid_node m" and "valid_call_list cs m"
and "∀i < length rs. rs!i ∈ get_return_edges (cs!i)" and "valid_return_list rs m"
and "length rs = length cs" and "ms = targetnodes rs"
obtains cs' rs' where "valid_node m'" and "valid_call_list cs' m'"
and "∀i < length rs'. rs'!i ∈ get_return_edges (cs'!i)"
and "valid_return_list rs' m'" and "length rs' = length cs'"
and "ms' = targetnodes rs'" and "upd_cs cs as = cs'"
proof(atomize_elim)
from ‹S,f ⊢ (m#ms,s) =as⇒ (m'#ms',s')› obtain msx s'' as' a'
where "as = as'@[a']" and "S,f ⊢ (m#ms,s) =as'⇒⇩τ (msx,s'')"
and "S,f ⊢ (msx,s'') -a'→ (m'#ms',s')"
by(fastforce elim:observable_moves.cases)
from ‹S,f ⊢ (msx,s'') -a'→ (m'#ms',s')› obtain m'' ms''
where [simp]:"msx = m''#ms''" by(cases msx)(auto elim:observable_move.cases)
from ‹S,f ⊢ (m#ms,s) =as'⇒⇩τ (msx,s'')› ‹valid_node m› ‹valid_call_list cs m›
‹∀i < length rs. rs!i ∈ get_return_edges (cs!i)› ‹valid_return_list rs m›
‹length rs = length cs› ‹ms = targetnodes rs›
obtain cs'' rs'' where "valid_node m''" and "valid_call_list cs'' m''"
and "∀i < length rs''. rs''!i ∈ get_return_edges (cs''!i)"
and "valid_return_list rs'' m''" and "length rs'' = length cs''"
and "ms'' = targetnodes rs''" and "upd_cs cs as' = cs''"
by(auto elim!:silent_moves_preserves_stacks)
with ‹S,f ⊢ (msx,s'') -a'→ (m'#ms',s')›
obtain cs' rs' where results:"valid_node m'" "valid_call_list cs' m'"
"∀i<length rs'. rs' ! i ∈ get_return_edges (cs' ! i)"
"valid_return_list rs' m'" "length rs' = length cs'" "ms' = targetnodes rs'"
and "upd_cs cs'' [a'] = cs'"
by(auto elim!:observable_move_preserves_stacks)
from ‹upd_cs cs as' = cs''› ‹upd_cs cs'' [a'] = cs'›
have "upd_cs cs (as'@[a']) = cs'" by(rule upd_cs_Append)
with ‹as = as'@[a']› results
show "∃cs' rs'. valid_node m' ∧ valid_call_list cs' m' ∧
(∀i<length rs'. rs' ! i ∈ get_return_edges (cs' ! i)) ∧
valid_return_list rs' m' ∧ length rs' = length cs' ∧ ms' = targetnodes rs' ∧
upd_cs cs as = cs'"
apply(rule_tac x="cs'" in exI)
apply(rule_tac x="rs'" in exI)
by clarsimp
qed
lemma silent_moves_slpa_path:
"⟦S,f ⊢ (m#ms''@ms,s) =as⇒⇩τ (m'#ms',s'); valid_node m; valid_call_list cs m;
∀i < length rs. rs!i ∈ get_return_edges (cs!i); valid_return_list rs m;
length rs = length cs; ms'' = targetnodes rs;
∀mx ∈ set ms. ∃mx'. call_of_return_node mx mx' ∧ mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙;
ms'' ≠ [] ⟶ (∃mx'. call_of_return_node (last ms'') mx' ∧ mx' ∉ ⌊HRB_slice S⌋⇘CFG⇙);
∀mx ∈ set ms'. ∃mx'. call_of_return_node mx mx' ∧ mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙⟧
⟹ same_level_path_aux cs as ∧ upd_cs cs as = [] ∧ m -as→* m' ∧ ms = ms'"
proof(induct S f "m#ms''@ms" s as "m'#ms'" s' arbitrary:m ms'' ms cs rs
rule:silent_moves.induct)
case (silent_moves_Nil sx S f) thus ?case
apply(cases ms'' rule:rev_cases) apply(auto intro:empty_path simp:targetnodes_def)
by(cases rs rule:rev_cases,auto)+
next
case (silent_moves_Cons S f sx a msx' sx' as sx'')
thus ?case
proof(induct _ _ "m#ms''@ms" _ _ _ _ rule:silent_move.induct)
case (silent_move_intra f a s s' S msx')
note IH = ‹⋀m ms'' ms cs rs. ⟦msx' = m # ms'' @ ms; valid_node m;
valid_call_list cs m; ∀i<length rs. rs ! i ∈ get_return_edges (cs ! i);
valid_return_list rs m; length rs = length cs; ms'' = targetnodes rs;
∀mx∈set ms. ∃mx'. call_of_return_node mx mx' ∧ mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙;
ms'' ≠ [] ⟶
(∃mx'. call_of_return_node (last ms'') mx' ∧ mx' ∉ ⌊HRB_slice S⌋⇘CFG⇙);
∀mx∈set ms'. ∃mx'. call_of_return_node mx mx' ∧ mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙⟧
⟹ same_level_path_aux cs as ∧ upd_cs cs as = [] ∧ m -as→* m' ∧ ms = ms'›
note callstack = ‹∀mx∈set ms. ∃mx'. call_of_return_node mx mx' ∧
mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
note callstack'' = ‹ms'' ≠ [] ⟶
(∃mx'. call_of_return_node (last ms'') mx' ∧ mx' ∉ ⌊HRB_slice S⌋⇘CFG⇙)›
note callstack' = ‹∀mx∈set ms'. ∃mx'. call_of_return_node mx mx' ∧
mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
from ‹valid_edge a› have "valid_node (targetnode a)" by simp
from ‹valid_edge a› ‹intra_kind (kind a)›
have "get_proc (sourcenode a) = get_proc (targetnode a)" by(rule get_proc_intra)
from ‹hd (m # ms'' @ ms) = sourcenode a› have "m = sourcenode a"
by simp
from ‹valid_call_list cs m› ‹m = sourcenode a›
‹get_proc (sourcenode a) = get_proc (targetnode a)›
have "valid_call_list cs (targetnode a)"
apply(clarsimp simp:valid_call_list_def)
apply(erule_tac x="cs'" in allE)
apply(erule_tac x="c" in allE)
by(auto split:list.split)
from ‹valid_return_list rs m› ‹m = sourcenode a›
‹get_proc (sourcenode a) = get_proc (targetnode a)›
have "valid_return_list rs (targetnode a)"
apply(clarsimp simp:valid_return_list_def)
apply(erule_tac x="cs'" in allE) apply clarsimp
by(case_tac cs') auto
from ‹msx' = targetnode a # tl (m # ms'' @ ms)›
have "msx' = targetnode a # ms'' @ ms" by simp
from IH[OF this ‹valid_node (targetnode a)› ‹valid_call_list cs (targetnode a)›
‹∀i<length rs. rs ! i ∈ get_return_edges (cs ! i)›
‹valid_return_list rs (targetnode a)› ‹length rs = length cs›
‹ms'' = targetnodes rs› callstack callstack'' callstack']
have "same_level_path_aux cs as" and "upd_cs cs as = []"
and "targetnode a -as→* m'" and "ms = ms'" by simp_all
from ‹intra_kind (kind a)› ‹same_level_path_aux cs as›
have "same_level_path_aux cs (a # as)" by(fastforce simp:intra_kind_def)
moreover
from ‹intra_kind (kind a)› ‹upd_cs cs as = []›
have "upd_cs cs (a # as) = []" by(fastforce simp:intra_kind_def)
moreover
from ‹valid_edge a› ‹m = sourcenode a› ‹targetnode a -as→* m'›
have "m -a # as→* m'" by(fastforce intro:Cons_path)
ultimately show ?case using ‹ms = ms'› by simp
next
case (silent_move_call f a s s' Q r p fs a' S msx')
note IH = ‹⋀m ms'' ms cs rs. ⟦msx' = m # ms'' @ ms; valid_node m; valid_call_list cs m;
∀i<length rs. rs ! i ∈ get_return_edges (cs ! i); valid_return_list rs m;
length rs = length cs; ms'' = targetnodes rs;
∀mx∈set ms. ∃mx'. call_of_return_node mx mx' ∧ mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙;
ms'' ≠ [] ⟶
(∃mx'. call_of_return_node (last ms'') mx' ∧ mx' ∉ ⌊HRB_slice S⌋⇘CFG⇙);
∀mx∈set ms'. ∃mx'. call_of_return_node mx mx' ∧ mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙⟧
⟹ same_level_path_aux cs as ∧ upd_cs cs as = [] ∧ m -as→* m' ∧ ms = ms'›
note callstack = ‹∀mx∈set ms. ∃mx'. call_of_return_node mx mx' ∧
mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
note callstack'' = ‹ms'' ≠ [] ⟶
(∃mx'. call_of_return_node (last ms'') mx' ∧ mx' ∉ ⌊HRB_slice S⌋⇘CFG⇙)›
note callstack' = ‹∀mx∈set ms'. ∃mx'. call_of_return_node mx mx' ∧
mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
from ‹valid_edge a› have "valid_node (targetnode a)" by simp
from ‹hd (m # ms'' @ ms) = sourcenode a› have "m = sourcenode a"
by simp
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› have "get_proc (targetnode a) = p"
by(rule get_proc_call)
with ‹valid_call_list cs m› ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹m = sourcenode a›
have "valid_call_list (a # cs) (targetnode a)"
apply(clarsimp simp:valid_call_list_def)
apply(case_tac cs') apply auto
apply(erule_tac x="list" in allE)
by(case_tac list)(auto simp:sourcenodes_def)
from ‹∀i<length rs. rs ! i ∈ get_return_edges (cs ! i)› ‹a' ∈ get_return_edges a›
have "∀i<length (a'#rs). (a'#rs) ! i ∈ get_return_edges ((a#cs) ! i)"
by auto(case_tac i,auto)
from ‹valid_edge a› ‹a' ∈ get_return_edges a› have "valid_edge a'"
by(rule get_return_edges_valid)
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹a' ∈ get_return_edges a›
obtain Q' f' where "kind a' = Q'↩⇘p⇙f'" by(fastforce dest!:call_return_edges)
from ‹valid_edge a'› ‹kind a' = Q'↩⇘p⇙f'› have "get_proc (sourcenode a') = p"
by(rule get_proc_return)
from ‹valid_edge a› ‹a' ∈ get_return_edges a›
have "get_proc (sourcenode a) = get_proc (targetnode a')"
by(rule get_proc_get_return_edge)
with ‹valid_return_list rs m› ‹valid_edge a'› ‹kind a' = Q'↩⇘p⇙f'›
‹get_proc (sourcenode a') = p› ‹get_proc (targetnode a) = p› ‹m = sourcenode a›
have "valid_return_list (a'#rs) (targetnode a)"
apply(clarsimp simp:valid_return_list_def)
apply(case_tac cs') apply auto
apply(erule_tac x="list" in allE)
by(case_tac list)(auto simp:targetnodes_def)
from ‹length rs = length cs› have "length (a'#rs) = length (a # cs)" by simp
from ‹ms'' = targetnodes rs›
have "targetnode a' # ms'' = targetnodes (a'#rs)" by(simp add:targetnodes_def)
from ‹msx' = targetnode a # targetnode a' # tl (m # ms'' @ ms)›
have "msx' = targetnode a # targetnode a' # ms'' @ ms" by simp
have "∃mx'. call_of_return_node (last (targetnode a' # ms'')) mx' ∧
mx' ∉ ⌊HRB_slice S⌋⇘CFG⇙"
proof(cases "ms'' = []")
case True
with ‹(∃m∈set (tl (m # ms'' @ ms)).
∃m'. call_of_return_node m m' ∧ m' ∉ ⌊HRB_slice S⌋⇘CFG⇙) ∨
hd (m # ms'' @ ms) ∉ ⌊HRB_slice S⌋⇘CFG⇙› ‹m = sourcenode a› callstack
have "sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙" by fastforce
from ‹valid_edge a› ‹a' ∈ get_return_edges a› have "valid_edge a'"
by(rule get_return_edges_valid)
with ‹valid_edge a› ‹a' ∈ get_return_edges a›
have "call_of_return_node (targetnode a') (sourcenode a)"
by(fastforce simp:call_of_return_node_def return_node_def)
with ‹sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙› True show ?thesis by fastforce
next
case False
with callstack'' show ?thesis by fastforce
qed
hence "targetnode a' # ms'' ≠ [] ⟶
(∃mx'. call_of_return_node (last (targetnode a' # ms'')) mx' ∧
mx' ∉ ⌊HRB_slice S⌋⇘CFG⇙)" by simp
from IH[OF _ ‹valid_node (targetnode a)› ‹valid_call_list (a # cs) (targetnode a)›
‹∀i<length (a'#rs). (a'#rs) ! i ∈ get_return_edges ((a#cs) ! i)›
‹valid_return_list (a'#rs) (targetnode a)› ‹length (a'#rs) = length (a # cs)›
‹targetnode a' # ms'' = targetnodes (a'#rs)› callstack this callstack']
‹msx' = targetnode a # targetnode a' # ms'' @ ms›
have "same_level_path_aux (a # cs) as" and "upd_cs (a # cs) as = []"
and "targetnode a -as→* m'" and "ms = ms'" by simp_all
from ‹kind a = Q:r↪⇘p⇙fs› ‹same_level_path_aux (a # cs) as›
have "same_level_path_aux cs (a # as)" by simp
moreover
from ‹kind a = Q:r↪⇘p⇙fs› ‹upd_cs (a # cs) as = []› have "upd_cs cs (a # as) = []"
by simp
moreover
from ‹valid_edge a› ‹m = sourcenode a› ‹targetnode a -as→* m'›
have "m -a # as→* m'" by(fastforce intro:Cons_path)
ultimately show ?case using ‹ms = ms'› by simp
next
case (silent_move_return f a s s' Q p f' S msx')
note IH = ‹⋀m ms'' ms cs rs. ⟦msx' = m # ms'' @ ms; valid_node m;
valid_call_list cs m; ∀i<length rs. rs ! i ∈ get_return_edges (cs ! i);
valid_return_list rs m; length rs = length cs; ms'' = targetnodes rs;
∀mx∈set ms. ∃mx'. call_of_return_node mx mx' ∧ mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙;
ms'' ≠ [] ⟶
(∃mx'. call_of_return_node (last ms'') mx' ∧ mx' ∉ ⌊HRB_slice S⌋⇘CFG⇙);
∀mx∈set ms'. ∃mx'. call_of_return_node mx mx' ∧ mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙⟧
⟹ same_level_path_aux cs as ∧ upd_cs cs as = [] ∧ m -as→* m' ∧ ms = ms'›
note callstack = ‹∀mx∈set ms. ∃mx'. call_of_return_node mx mx' ∧
mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
note callstack'' = ‹ms'' ≠ [] ⟶
(∃mx'. call_of_return_node (last ms'') mx' ∧ mx' ∉ ⌊HRB_slice S⌋⇘CFG⇙)›
note callstack' = ‹∀mx∈set ms'. ∃mx'. call_of_return_node mx mx' ∧
mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
have "ms'' ≠ []"
proof
assume "ms'' = []"
with callstack
‹∃m∈set (tl (m # ms'' @ ms)). ∃m'. call_of_return_node m m' ∧ m' ∉ ⌊HRB_slice S⌋⇘CFG⇙›
show False by fastforce
qed
with ‹hd (tl (m # ms'' @ ms)) = targetnode a›
obtain xs where "ms'' = targetnode a # xs" by(cases ms'') auto
with ‹ms'' = targetnodes rs› obtain r' rs' where "rs = r' # rs'"
and "targetnode a = targetnode r'" and "xs = targetnodes rs'"
by(cases rs)(auto simp:targetnodes_def)
from ‹rs = r' # rs'› ‹length rs = length cs› obtain c' cs' where "cs = c' # cs'"
and "length rs' = length cs'" by(cases cs) auto
from ‹∀i<length rs. rs ! i ∈ get_return_edges (cs ! i)›
‹rs = r' # rs'› ‹cs = c' # cs'›
have "∀i<length rs'. rs' ! i ∈ get_return_edges (cs' ! i)"
and "r' ∈ get_return_edges c'" by auto
from ‹valid_edge a› have "valid_node (targetnode a)" by simp
from ‹hd (m # ms'' @ ms) = sourcenode a› have "m = sourcenode a"
by simp
from ‹valid_call_list cs m› ‹cs = c' # cs'›
obtain p' Q' r fs' where "valid_edge c'" and "kind c' = Q':r↪⇘p'⇙fs'"
and "p' = get_proc m"
apply(auto simp:valid_call_list_def)
by(erule_tac x="[]" in allE) auto
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f'›
have "get_proc (sourcenode a) = p" by(rule get_proc_return)
with ‹m = sourcenode a› ‹p' = get_proc m› have [simp]:"p' = p" by simp
from ‹valid_edge c'› ‹kind c' = Q':r↪⇘p'⇙fs'›
have "get_proc (targetnode c') = p" by(fastforce intro:get_proc_call)
from ‹valid_edge c'› ‹r' ∈ get_return_edges c'› have "valid_edge r'"
by(rule get_return_edges_valid)
from ‹valid_edge c'› ‹kind c' = Q':r↪⇘p'⇙fs'› ‹r' ∈ get_return_edges c'›
obtain Q'' f'' where "kind r' = Q''↩⇘p⇙f''" by(fastforce dest!:call_return_edges)
with ‹valid_edge r'› have "get_proc (sourcenode r') = p" by(rule get_proc_return)
from ‹valid_edge r'› ‹kind r' = Q''↩⇘p⇙f''› have "method_exit (sourcenode r')"
by(fastforce simp:method_exit_def)
from ‹valid_edge a› ‹kind a = Q↩⇘p⇙f'› have "method_exit (sourcenode a)"
by(fastforce simp:method_exit_def)
with ‹method_exit (sourcenode r')› ‹get_proc (sourcenode r') = p›
‹get_proc (sourcenode a) = p›
have "sourcenode a = sourcenode r'" by(fastforce intro:method_exit_unique)
with ‹valid_edge a› ‹valid_edge r'› ‹targetnode a = targetnode r'›
have "a = r'" by(fastforce intro:edge_det)
from ‹valid_edge c'› ‹r' ∈ get_return_edges c'› ‹targetnode a = targetnode r'›
have "get_proc (sourcenode c') = get_proc (targetnode a)"
by(fastforce intro:get_proc_get_return_edge)
from ‹valid_call_list cs m› ‹cs = c' # cs'›
‹get_proc (sourcenode c') = get_proc (targetnode a)›
have "valid_call_list cs' (targetnode a)"
apply(clarsimp simp:valid_call_list_def)
apply(hypsubst_thin)
apply(erule_tac x="c' # cs'" in allE)
by(case_tac cs')(auto simp:sourcenodes_def)
from ‹valid_return_list rs m› ‹rs = r' # rs'› ‹targetnode a = targetnode r'›
have "valid_return_list rs' (targetnode a)"
apply(clarsimp simp:valid_return_list_def)
apply(erule_tac x="r' # cs'" in allE)
by(case_tac cs')(auto simp:targetnodes_def)
from ‹msx' = tl (m # ms'' @ ms)› ‹ms'' = targetnode a # xs›
have "msx' = targetnode a # xs @ ms" by simp
from callstack'' ‹ms'' = targetnode a # xs›
have "xs ≠ [] ⟶
(∃mx'. call_of_return_node (last xs) mx' ∧ mx' ∉ ⌊HRB_slice S⌋⇘CFG⇙)"
by fastforce
from IH[OF ‹msx' = targetnode a # xs @ ms› ‹valid_node (targetnode a)›
‹valid_call_list cs' (targetnode a)›
‹∀i<length rs'. rs' ! i ∈ get_return_edges (cs' ! i)›
‹valid_return_list rs' (targetnode a)› ‹length rs' = length cs'›
‹xs = targetnodes rs'› callstack this callstack']
have "same_level_path_aux cs' as" and "upd_cs cs' as = []"
and "targetnode a -as→* m'" and "ms = ms'" by simp_all
from ‹kind a = Q↩⇘p⇙f'› ‹same_level_path_aux cs' as› ‹cs = c' # cs'›
‹r' ∈ get_return_edges c'› ‹a = r'›
have "same_level_path_aux cs (a # as)" by simp
moreover
from ‹upd_cs cs' as = []› ‹kind a = Q↩⇘p⇙f'› ‹cs = c' # cs'›
have "upd_cs cs (a # as) = []" by simp
moreover
from ‹valid_edge a› ‹m = sourcenode a› ‹targetnode a -as→* m'›
have "m -a # as→* m'" by(fastforce intro:Cons_path)
ultimately show ?case using ‹ms = ms'› by simp
qed
qed
lemma silent_moves_slp:
"⟦S,f ⊢ (m#ms,s) =as⇒⇩τ (m'#ms',s'); valid_node m;
∀mx ∈ set ms. ∃mx'. call_of_return_node mx mx' ∧ mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙;
∀mx ∈ set ms'. ∃mx'. call_of_return_node mx mx' ∧ mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙⟧
⟹ m -as→⇘sl⇙* m' ∧ ms = ms'"
by(fastforce dest!:silent_moves_slpa_path
[of _ _ _ "[]" _ _ _ _ _ _ "[]" "[]",simplified]
simp:targetnodes_def valid_call_list_def valid_return_list_def
same_level_path_def slp_def)
lemma slpa_silent_moves_callstacks_eq:
"⟦same_level_path_aux cs as; S,f ⊢ (m#msx@ms,s) =as⇒⇩τ (m'#ms',s');
length ms = length ms'; valid_call_list cs m;
∀i < length rs. rs!i ∈ get_return_edges (cs!i); valid_return_list rs m;
length rs = length cs; msx = targetnodes rs⟧
⟹ ms = ms'"
proof(induct arbitrary:m msx s rs rule:slpa_induct)
case (slpa_empty cs)
from ‹S,f ⊢ (m # msx @ ms,s) =[]⇒⇩τ (m' # ms',s')›
have "msx@ms = ms'" by(fastforce elim:silent_moves.cases)
with ‹length ms = length ms'› show ?case by fastforce
next
case (slpa_intra cs a as)
note IH = ‹⋀m msx s rs. ⟦S,f ⊢ (m # msx @ ms,s) =as⇒⇩τ (m' # ms',s');
length ms = length ms'; valid_call_list cs m;
∀i<length rs. rs ! i ∈ get_return_edges (cs ! i);
valid_return_list rs m; length rs = length cs; msx = targetnodes rs⟧
⟹ ms = ms'›
from ‹S,f ⊢ (m # msx @ ms,s) =a # as⇒⇩τ (m' # ms',s')› obtain ms'' s''
where "S,f ⊢ (m # msx @ ms,s) -a→⇩τ (ms'',s'')"
and "S,f ⊢ (ms'',s'') =as⇒⇩τ (m' # ms',s')"
by(auto elim:silent_moves.cases)
from ‹S,f ⊢ (m # msx @ ms,s) -a→⇩τ (ms'',s'')› ‹intra_kind (kind a)›
have "valid_edge a" and [simp]:"m = sourcenode a" "ms'' = targetnode a # msx @ ms"
by(fastforce elim:silent_move.cases simp:intra_kind_def)+
from ‹valid_edge a› ‹intra_kind (kind a)›
have "get_proc (sourcenode a) = get_proc (targetnode a)" by(rule get_proc_intra)
from ‹valid_call_list cs m› ‹m = sourcenode a›
‹get_proc (sourcenode a) = get_proc (targetnode a)›
have "valid_call_list cs (targetnode a)"
apply(clarsimp simp:valid_call_list_def)
apply(erule_tac x="cs'" in allE)
apply(erule_tac x="c" in allE)
by(auto split:list.split)
from ‹valid_return_list rs m› ‹m = sourcenode a›
‹get_proc (sourcenode a) = get_proc (targetnode a)›
have "valid_return_list rs (targetnode a)"
apply(clarsimp simp:valid_return_list_def)
apply(erule_tac x="cs'" in allE) apply clarsimp
by(case_tac cs') auto
from ‹S,f ⊢ (ms'',s'') =as⇒⇩τ (m' # ms',s')›
have "S,f ⊢ (targetnode a # msx @ ms,s'') =as⇒⇩τ (m' # ms',s')" by simp
from IH[OF this ‹length ms = length ms'› ‹valid_call_list cs (targetnode a)›
‹∀i<length rs. rs ! i ∈ get_return_edges (cs ! i)›
‹valid_return_list rs (targetnode a)› ‹length rs = length cs›
‹msx = targetnodes rs›] show ?case .
next
case (slpa_Call cs a as Q r p fs)
note IH = ‹⋀m msx s rs. ⟦S,f ⊢ (m # msx @ ms,s) =as⇒⇩τ (m' # ms',s');
length ms = length ms'; valid_call_list (a # cs) m;
∀i<length rs. rs ! i ∈ get_return_edges ((a # cs) ! i);
valid_return_list rs m; length rs = length (a # cs);
msx = targetnodes rs⟧
⟹ ms = ms'›
from ‹S,f ⊢ (m # msx @ ms,s) =a # as⇒⇩τ (m' # ms',s')› obtain ms'' s''
where "S,f ⊢ (m # msx @ ms,s) -a→⇩τ (ms'',s'')"
and "S,f ⊢ (ms'',s'') =as⇒⇩τ (m' # ms',s')"
by(auto elim:silent_moves.cases)
from ‹S,f ⊢ (m # msx @ ms,s) -a→⇩τ (ms'',s'')› ‹kind a = Q:r↪⇘p⇙fs›
obtain a' where "valid_edge a" and [simp]:"m = sourcenode a"
and [simp]:"ms'' = targetnode a # targetnode a' # msx @ ms"
and "a' ∈ get_return_edges a"
by(auto elim:silent_move.cases simp:intra_kind_def)
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› have "get_proc (targetnode a) = p"
by(rule get_proc_call)
with ‹valid_call_list cs m› ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹m = sourcenode a›
have "valid_call_list (a # cs) (targetnode a)"
apply(clarsimp simp:valid_call_list_def)
apply(case_tac cs') apply auto
apply(erule_tac x="list" in allE)
by(case_tac list)(auto simp:sourcenodes_def)
from ‹∀i<length rs. rs ! i ∈ get_return_edges (cs ! i)› ‹a' ∈ get_return_edges a›
have "∀i<length (a'#rs). (a'#rs) ! i ∈ get_return_edges ((a#cs) ! i)"
by auto(case_tac i,auto)
from ‹valid_edge a› ‹a' ∈ get_return_edges a› have "valid_edge a'"
by(rule get_return_edges_valid)
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹a' ∈ get_return_edges a›
obtain Q' f' where "kind a' = Q'↩⇘p⇙f'" by(fastforce dest!:call_return_edges)
from ‹valid_edge a'› ‹kind a' = Q'↩⇘p⇙f'› have "get_proc (sourcenode a') = p"
by(rule get_proc_return)
from ‹valid_edge a› ‹a' ∈ get_return_edges a›
have "get_proc (sourcenode a) = get_proc (targetnode a')"
by(rule get_proc_get_return_edge)
with ‹valid_return_list rs m› ‹valid_edge a'› ‹kind a' = Q'↩⇘p⇙f'›
‹get_proc (sourcenode a') = p› ‹get_proc (targetnode a) = p› ‹m = sourcenode a›
have "valid_return_list (a'#rs) (targetnode a)"
apply(clarsimp simp:valid_return_list_def)
apply(case_tac cs') apply auto
apply(erule_tac x="list" in allE)
by(case_tac list)(auto simp:targetnodes_def)
from ‹length rs = length cs› have "length (a'#rs) = length (a#cs)" by simp
from ‹msx = targetnodes rs› have "targetnode a' # msx = targetnodes (a' # rs)"
by(simp add:targetnodes_def)
from ‹S,f ⊢ (ms'',s'') =as⇒⇩τ (m' # ms',s')›
have "S,f ⊢ (targetnode a # (targetnode a' # msx) @ ms,s'') =as⇒⇩τ (m' # ms',s')"
by simp
from IH[OF this ‹length ms = length ms'› ‹valid_call_list (a # cs) (targetnode a)›
‹∀i<length (a'#rs). (a'#rs) ! i ∈ get_return_edges ((a#cs) ! i)›
‹valid_return_list (a'#rs) (targetnode a)› ‹length (a'#rs) = length (a#cs)›
‹targetnode a' # msx = targetnodes (a' # rs)›] show ?case .
next
case (slpa_Return cs a as Q p f' c' cs')
note IH = ‹⋀m msx s rs. ⟦S,f ⊢ (m # msx @ ms,s) =as⇒⇩τ (m' # ms',s');
length ms = length ms'; valid_call_list cs' m;
∀i<length rs. rs ! i ∈ get_return_edges (cs' ! i); valid_return_list rs m;
length rs = length cs'; msx = targetnodes rs⟧
⟹ ms = ms'›
from ‹S,f ⊢ (m # msx @ ms,s) =a # as⇒⇩τ (m' # ms',s')› obtain ms'' s''
where "S,f ⊢ (m # msx @ ms,s) -a→⇩τ (ms'',s'')"
and "S,f ⊢ (ms'',s'') =as⇒⇩τ (m' # ms',s')"
by(auto elim:silent_moves.cases)
from ‹S,f ⊢ (m # msx @ ms,s) -a→⇩τ (ms'',s'')› ‹kind a = Q↩⇘p⇙f'›
have "valid_edge a" and "m = sourcenode a" and "hd (msx @ ms) = targetnode a"
and "ms'' = msx @ ms" and "s'' ≠ []" and "length s = Suc(length s'')"
and "length (m # msx @ ms) = length s"
by(auto elim:silent_move.cases simp:intra_kind_def)
from ‹msx = targetnodes rs› ‹length rs = length cs› ‹cs = c' # cs'›
obtain mx' msx' where "msx = mx'#msx'"
by(cases msx)(fastforce simp:targetnodes_def)+
with ‹hd (msx @ ms) = targetnode a› have "mx' = targetnode a" by simp
from ‹valid_call_list cs m› ‹cs = c' # cs'› have "valid_edge c'"
by(fastforce simp:valid_call_list_def)
from ‹valid_edge c'› ‹a ∈ get_return_edges c'›
have "get_proc (sourcenode c') = get_proc (targetnode a)"
by(rule get_proc_get_return_edge)
from ‹valid_call_list cs m› ‹cs = c' # cs'›
‹get_proc (sourcenode c') = get_proc (targetnode a)›
have "valid_call_list cs' (targetnode a)"
apply(clarsimp simp:valid_call_list_def)
apply(hypsubst_thin)
apply(erule_tac x="c' # cs'" in allE)
by(case_tac cs')(auto simp:sourcenodes_def)
from ‹length rs = length cs› ‹cs = c' # cs'› obtain r' rs'
where [simp]:"rs = r'#rs'" and "length rs' = length cs'" by(cases rs) auto
from ‹∀i<length rs. rs ! i ∈ get_return_edges (cs ! i)› ‹cs = c' # cs'›
have "∀i<length rs'. rs' ! i ∈ get_return_edges (cs' ! i)"
and "r' ∈ get_return_edges c'" by auto
with ‹valid_edge c'› ‹a ∈ get_return_edges c'› have [simp]:"a = r'"
by -(rule get_return_edges_unique)
with ‹valid_return_list rs m›
have "valid_return_list rs' (targetnode a)"
apply(clarsimp simp:valid_return_list_def)
apply(erule_tac x="r' # cs'" in allE)
by(case_tac cs')(auto simp:targetnodes_def)
from ‹msx = targetnodes rs› ‹msx = mx'#msx'› ‹rs = r'#rs'›
have "msx' = targetnodes rs'" by(simp add:targetnodes_def)
from ‹S,f ⊢ (ms'',s'') =as⇒⇩τ (m' # ms',s')› ‹msx = mx'#msx'›
‹ms'' = msx @ ms› ‹mx' = targetnode a›
have "S,f ⊢ (targetnode a # msx' @ ms,s'') =as⇒⇩τ (m' # ms',s')" by simp
from IH[OF this ‹length ms = length ms'› ‹valid_call_list cs' (targetnode a)›
‹∀i<length rs'. rs' ! i ∈ get_return_edges (cs' ! i)›
‹valid_return_list rs' (targetnode a)› ‹length rs' = length cs'›
‹msx' = targetnodes rs'›] show ?case .
qed
lemma silent_moves_same_level_path:
assumes "S,kind ⊢ (m#ms,s) =as⇒⇩τ (m'#ms',s')" and "m -as→⇘sl⇙* m'" shows "ms = ms'"
proof -
from ‹S,kind ⊢ (m#ms,s) =as⇒⇩τ (m'#ms',s')› obtain cf cfs where "s = cf#cfs"
by(cases s)(auto dest:silent_moves_equal_length)
with ‹S,kind ⊢ (m#ms,s) =as⇒⇩τ (m'#ms',s')›
have "transfers (kinds as) (cf#cfs) = s'"
by(fastforce intro:silent_moves_preds_transfers simp:kinds_def)
with ‹m -as→⇘sl⇙* m'› obtain cf' where "s' = cf'#cfs"
by -(drule slp_callstack_length_equal,auto)
from ‹S,kind ⊢ (m#ms,s) =as⇒⇩τ (m'#ms',s')›
have "length (m#ms) = length s" and "length (m'#ms') = length s'"
by(rule silent_moves_equal_length)+
with ‹s = cf#cfs› ‹s' = cf'#cfs› have "length ms = length ms'" by simp
from ‹m -as→⇘sl⇙* m'› have "same_level_path_aux [] as"
by(simp add:slp_def same_level_path_def)
with ‹S,kind ⊢ (m#ms,s) =as⇒⇩τ (m'#ms',s')› ‹length ms = length ms'›
show ?thesis by(auto elim!:slpa_silent_moves_callstacks_eq
simp:targetnodes_def valid_call_list_def valid_return_list_def)
qed
lemma silent_moves_call_edge:
assumes "S,kind ⊢ (m#ms,s) =as⇒⇩τ (m'#ms',s')" and "valid_node m"
and callstack:"∀mx ∈ set ms. ∃mx'. call_of_return_node mx mx' ∧
mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙"
and rest:"∀i < length rs. rs!i ∈ get_return_edges (cs!i)"
"ms = targetnodes rs" "valid_return_list rs m" "length rs = length cs"
obtains as' a as'' where "as = as'@a#as''" and "∃Q r p fs. kind a = Q:r↪⇘p⇙fs"
and "call_of_return_node (hd ms') (sourcenode a)"
and "targetnode a -as''→⇘sl⇙* m'"
| "ms' = ms"
proof(atomize_elim)
from ‹S,kind ⊢ (m#ms,s) =as⇒⇩τ (m'#ms',s')›
show "(∃as' a as''. as = as' @ a # as'' ∧ (∃Q r p fs. kind a = Q:r↪⇘p⇙fs) ∧
call_of_return_node (hd ms') (sourcenode a) ∧ targetnode a -as''→⇘sl⇙* m') ∨
ms' = ms"
proof(induct as arbitrary:m' ms' s' rule:length_induct)
fix as m' ms' s'
assume IH:"∀as'. length as' < length as ⟶
(∀mx msx sx. S,kind ⊢ (m#ms,s) =as'⇒⇩τ (mx#msx,sx) ⟶
(∃asx a asx'. as' = asx @ a # asx' ∧ (∃Q r p fs. kind a = Q:r↪⇘p⇙fs) ∧
call_of_return_node (hd msx) (sourcenode a) ∧ targetnode a -asx'→⇘sl⇙* mx) ∨
msx = ms)"
and "S,kind ⊢ (m#ms,s) =as⇒⇩τ (m'#ms',s')"
show "(∃as' a as''. as = as' @ a # as'' ∧ (∃Q r p fs. kind a = Q:r↪⇘p⇙fs) ∧
call_of_return_node (hd ms') (sourcenode a) ∧ targetnode a -as''→⇘sl⇙* m') ∨
ms' = ms"
proof(cases as rule:rev_cases)
case Nil
with ‹S,kind ⊢ (m#ms,s) =as⇒⇩τ (m'#ms',s')› have "ms = ms'"
by(fastforce elim:silent_moves.cases)
thus ?thesis by simp
next
case (snoc as' a')
with ‹S,kind ⊢ (m#ms,s) =as⇒⇩τ (m'#ms',s')›
obtain ms'' s'' where "S,kind ⊢ (m#ms,s) =as'⇒⇩τ (ms'',s'')"
and "S,kind ⊢ (ms'',s'') =[a']⇒⇩τ (m'#ms',s')"
by(fastforce elim:silent_moves_split)
from snoc have "length as' < length as" by simp
from ‹S,kind ⊢ (ms'',s'') =[a']⇒⇩τ (m'#ms',s')›
have "S,kind ⊢ (ms'',s'') -a'→⇩τ (m'#ms',s')"
by(fastforce elim:silent_moves.cases)
show ?thesis
proof(cases "kind a'" rule:edge_kind_cases)
case Intra
with ‹S,kind ⊢ (ms'',s'') -a'→⇩τ (m'#ms',s')›
have "valid_edge a'" and "m' = targetnode a'"
by(auto elim:silent_move.cases simp:intra_kind_def)
from ‹S,kind ⊢ (ms'',s'') -a'→⇩τ (m'#ms',s')› ‹intra_kind (kind a')›
have "ms'' = sourcenode a'#ms'"
by -(erule silent_move.cases,auto simp:intra_kind_def,(cases ms'',auto)+)
with IH ‹length as' < length as› ‹S,kind ⊢ (m#ms,s) =as'⇒⇩τ (ms'',s'')›
have "(∃asx ax asx'. as' = asx @ ax # asx' ∧ (∃Q r p fs. kind ax = Q:r↪⇘p⇙fs) ∧
call_of_return_node (hd ms') (sourcenode ax) ∧
targetnode ax -asx'→⇘sl⇙* sourcenode a') ∨ ms' = ms"
by simp blast
thus ?thesis
proof
assume "∃asx ax asx'. as' = asx @ ax # asx' ∧
(∃Q r p fs. kind ax = Q:r↪⇘p⇙fs) ∧
call_of_return_node (hd ms') (sourcenode ax) ∧
targetnode ax -asx'→⇘sl⇙* sourcenode a'"
then obtain asx ax asx' where "as' = asx @ ax # asx'"
and "∃Q r p fs. kind ax = Q:r↪⇘p⇙fs"
and "call_of_return_node (hd ms') (sourcenode ax)"
and "targetnode ax -asx'→⇘sl⇙* sourcenode a'"
by blast
from ‹as' = asx @ ax # asx'› have "as'@[a'] = asx @ ax # (asx' @ [a'])"
by simp
moreover
from ‹targetnode ax -asx'→⇘sl⇙* sourcenode a'› ‹intra_kind (kind a')›
‹m' = targetnode a'› ‹valid_edge a'›
have "targetnode ax -asx'@[a']→⇘sl⇙* m'"
by(fastforce intro:path_Append path_edge same_level_path_aux_Append
upd_cs_Append simp:slp_def same_level_path_def intra_kind_def)
ultimately show ?thesis using ‹∃Q r p fs. kind ax = Q:r↪⇘p⇙fs›
‹call_of_return_node (hd ms') (sourcenode ax)› snoc by blast
next
assume "ms' = ms" thus ?thesis by simp
qed
next
case (Call Q r p fs)
with ‹S,kind ⊢ (ms'',s'') -a'→⇩τ (m'#ms',s')› obtain a''
where "valid_edge a'" and "a'' ∈ get_return_edges a'"
and "hd ms'' = sourcenode a'" and "m' = targetnode a'"
and "ms' = (targetnode a'')#tl ms''" and "length ms'' = length s''"
and "pred (kind a') s''"
by(auto elim:silent_move.cases simp:intra_kind_def)
from ‹valid_edge a'› ‹a'' ∈ get_return_edges a'› have "valid_edge a''"
by(rule get_return_edges_valid)
from ‹valid_edge a''› ‹valid_edge a'› ‹a'' ∈ get_return_edges a'›
have "return_node (targetnode a'')" by(fastforce simp:return_node_def)
with ‹valid_edge a'› ‹valid_edge a''›
‹a'' ∈ get_return_edges a'› ‹ms' = (targetnode a'')#tl ms''›
have "call_of_return_node (hd ms') (sourcenode a')"
by(simp add:call_of_return_node_def) blast
with snoc ‹kind a' = Q:r↪⇘p⇙fs› ‹m' = targetnode a'› ‹valid_edge a'›
show ?thesis by(fastforce intro:empty_path simp:slp_def same_level_path_def)
next
case (Return Q p f)
with ‹S,kind ⊢ (ms'',s'') -a'→⇩τ (m'#ms',s')›
have "valid_edge a'" and "hd ms'' = sourcenode a'"
and "hd(tl ms'') = targetnode a'" and "m'#ms' = tl ms''"
and "length ms'' = length s''" and "length s'' = Suc(length s')"
and "s' ≠ []"
by(auto elim:silent_move.cases simp:intra_kind_def)
hence "ms'' = sourcenode a' # targetnode a' # ms'" by(cases ms'') auto
with ‹length as' < length as› ‹S,kind ⊢ (m#ms,s) =as'⇒⇩τ (ms'',s'')› IH
have "(∃asx ax asx'. as' = asx @ ax # asx' ∧ (∃Q r p fs. kind ax = Q:r↪⇘p⇙fs) ∧
call_of_return_node (targetnode a') (sourcenode ax) ∧
targetnode ax -asx'→⇘sl⇙* sourcenode a') ∨ ms = targetnode a' # ms'"
apply - apply(erule_tac x="as'" in allE) apply clarsimp
apply(erule_tac x="sourcenode a'" in allE)
apply(erule_tac x="targetnode a' # ms'" in allE)
by fastforce
thus ?thesis
proof
assume "∃asx ax asx'. as' = asx @ ax # asx' ∧
(∃Q r p fs. kind ax = Q:r↪⇘p⇙fs) ∧
call_of_return_node (targetnode a') (sourcenode ax) ∧
targetnode ax -asx'→⇘sl⇙* sourcenode a'"
then obtain asx ax asx' where "as' = asx @ ax # asx'"
and "∃Q r p fs. kind ax = Q:r↪⇘p⇙fs"
and "call_of_return_node (targetnode a') (sourcenode ax)"
and "targetnode ax -asx'→⇘sl⇙* sourcenode a'" by blast
from ‹as' = asx @ ax # asx'› snoc have"length asx < length as" by simp
moreover
from ‹S,kind ⊢ (m#ms,s) =as⇒⇩τ (m'#ms',s')› snoc ‹as' = asx @ ax # asx'›
obtain msx sx where "S,kind ⊢ (m#ms,s) =asx⇒⇩τ (msx,sx)"
and "S,kind ⊢ (msx,sx) =ax#asx'@[a']⇒⇩τ (m'#ms',s')"
by(fastforce elim:silent_moves_split)
from ‹S,kind ⊢ (msx,sx) =ax#asx'@[a']⇒⇩τ (m'#ms',s')›
obtain xs x ys y where "S,kind ⊢ (msx,sx) -ax→⇩τ (xs,x)"
and "S,kind ⊢ (xs,x) =asx'⇒⇩τ (ys,y)"
and "S,kind ⊢ (ys,y) =[a']⇒⇩τ (m'#ms',s')"
apply - apply(erule silent_moves.cases) apply auto
by(erule silent_moves_split) auto
from ‹S,kind ⊢ (msx,sx) -ax→⇩τ (xs,x)› ‹∃Q r p fs. kind ax = Q:r↪⇘p⇙fs›
obtain msx' ax' where "msx = sourcenode ax#msx'"
and "ax' ∈ get_return_edges ax"
and [simp]:"xs = (targetnode ax)#(targetnode ax')#msx'"
and "length x = Suc(length sx)" and "length msx = length sx"
apply - apply(erule silent_move.cases) apply(auto simp:intra_kind_def)
by(cases msx,auto)+
from ‹S,kind ⊢ (ys,y) =[a']⇒⇩τ (m'#ms',s')› obtain msy
where "ys = sourcenode a'#msy"
apply - apply(erule silent_moves.cases) apply auto
apply(erule silent_move.cases)
by(cases ys,auto)+
with ‹S,kind ⊢ (xs,x) =asx'⇒⇩τ (ys,y)›
‹targetnode ax -asx'→⇘sl⇙* sourcenode a'›
‹xs = (targetnode ax)#(targetnode ax')#msx'›
have "(targetnode ax')#msx' = msy" apply simp
by(fastforce intro:silent_moves_same_level_path)
with ‹S,kind ⊢ (ys,y) =[a']⇒⇩τ (m'#ms',s')› ‹kind a' = Q↩⇘p⇙f›
‹ys = sourcenode a'#msy›
have "m' = targetnode a'" and "msx' = ms'"
by(fastforce elim:silent_moves.cases silent_move.cases
simp:intra_kind_def)+
with ‹S,kind ⊢ (m#ms,s) =asx⇒⇩τ (msx,sx)› ‹msx = sourcenode ax#msx'›
have "S,kind ⊢ (m#ms,s) =asx⇒⇩τ (sourcenode ax#ms',sx)" by simp
ultimately have "(∃xs x xs'. asx = xs@x#xs' ∧
(∃Q r p fs. kind x = Q:r↪⇘p⇙fs) ∧
call_of_return_node (hd ms') (sourcenode x) ∧
targetnode x -xs'→⇘sl⇙* sourcenode ax) ∨ ms = ms'" using IH
by simp blast
thus ?thesis
proof
assume "∃xs x xs'. asx = xs@x#xs' ∧ (∃Q r p fs. kind x = Q:r↪⇘p⇙fs) ∧
call_of_return_node (hd ms') (sourcenode x) ∧
targetnode x -xs'→⇘sl⇙* sourcenode ax"
then obtain xs x xs' where "asx = xs@x#xs'"
and "∃Q r p fs. kind x = Q:r↪⇘p⇙fs"
and "call_of_return_node (hd ms') (sourcenode x)"
and "targetnode x -xs'→⇘sl⇙* sourcenode ax" by blast
from ‹asx = xs@x#xs'› ‹as' = asx @ ax # asx'› snoc
have "as = xs@x#(xs'@ax#asx'@[a'])" by simp
from ‹S,kind ⊢ (m#ms,s) =as⇒⇩τ (m'#ms',s')› ‹valid_node m› rest
have "m -as→* m'" and "valid_path_aux cs as"
by(auto dest:silent_moves_vpa_path[of _ _ _ _ _ _ _ _ _ rs cs]
simp:valid_call_list_def valid_return_list_def targetnodes_def)
hence "m -as→⇩√* m'"
by(fastforce intro:valid_path_aux_valid_path simp:vp_def)
with snoc have "m -as'→⇩√* sourcenode a'"
by(auto elim:path_split_snoc dest:valid_path_aux_split
simp:vp_def valid_path_def)
with ‹as' = asx @ ax # asx'›
have "valid_edge ax" and "targetnode ax -asx'→* sourcenode a'"
by(auto dest:path_split simp:vp_def)
hence "sourcenode ax -ax#asx'→* sourcenode a'"
by(fastforce intro:Cons_path)
from ‹valid_edge a'› have "sourcenode a' -[a']→* targetnode a'"
by(rule path_edge)
with ‹sourcenode ax -ax#asx'→* sourcenode a'›
have "sourcenode ax -(ax#asx')@[a']→* targetnode a'"
by(rule path_Append)
from ‹m -as→⇩√* m'› snoc ‹as' = asx @ ax # asx'› snoc
have "valid_path_aux ([]@(upd_cs [] asx)) (ax # asx' @ [a'])"
by(fastforce dest:valid_path_aux_split simp:vp_def valid_path_def)
hence "valid_path_aux [] (ax#asx'@[a'])"
by(rule valid_path_aux_callstack_prefix)
with ‹∃Q r p fs. kind ax = Q:r↪⇘p⇙fs›
have "valid_path_aux [ax] (asx'@[a'])" by fastforce
hence "valid_path_aux (upd_cs [ax] asx') [a']"
by(rule valid_path_aux_split)
from ‹targetnode ax -asx'→⇘sl⇙* sourcenode a'›
have "same_level_path_aux [] asx'" and "upd_cs [] asx' = []"
by(simp_all add:slp_def same_level_path_def)
hence "upd_cs ([]@[ax]) asx' = []@[ax]"
by(rule same_level_path_upd_cs_callstack_Append)
with ‹valid_path_aux (upd_cs [ax] asx') [a']›
have "valid_path_aux [ax] [a']" by(simp del:valid_path_aux.simps)
with ‹∃Q r p fs. kind ax = Q:r↪⇘p⇙fs› ‹kind a' = Q↩⇘p⇙f›
have "a' ∈ get_return_edges ax" by simp
with ‹upd_cs ([]@[ax]) asx' = []@[ax]› ‹kind a' = Q↩⇘p⇙f›
have "upd_cs [ax] (asx'@[a']) = []" by(fastforce intro:upd_cs_Append)
with ‹∃Q r p fs. kind ax = Q:r↪⇘p⇙fs›
have "upd_cs [] (ax#asx'@[a']) = []" by fastforce
from ‹targetnode ax -asx'→⇘sl⇙* sourcenode a'›
have "same_level_path_aux [] asx'" and "upd_cs [] asx' = []"
by(simp_all add:slp_def same_level_path_def)
hence "same_level_path_aux ([]@[ax]) asx'"
by -(rule same_level_path_aux_callstack_Append)
with ‹∃Q r p fs. kind ax = Q:r↪⇘p⇙fs› ‹kind a' = Q↩⇘p⇙f›
‹a' ∈ get_return_edges ax› ‹upd_cs ([]@[ax]) asx' = []@[ax]›
have "same_level_path_aux [] ((ax#asx')@[a'])"
by(fastforce intro:same_level_path_aux_Append)
with ‹upd_cs [] (ax#asx'@[a']) = []›
‹sourcenode ax -(ax#asx')@[a']→* targetnode a'›
have "sourcenode ax -(ax#asx')@[a']→⇘sl⇙* targetnode a'"
by(simp add:slp_def same_level_path_def)
with ‹targetnode x -xs'→⇘sl⇙* sourcenode ax›
have "targetnode x -xs'@((ax#asx')@[a'])→⇘sl⇙* targetnode a'"
by(rule slp_Append)
with ‹∃Q r p fs. kind x = Q:r↪⇘p⇙fs›
‹call_of_return_node (hd ms') (sourcenode x)›
‹as = xs@x#(xs'@ax#asx'@[a'])› ‹m' = targetnode a'›
show ?thesis by simp blast
next
assume "ms = ms'" thus ?thesis by simp
qed
next
assume "ms = targetnode a' # ms'"
from ‹S,kind ⊢ (ms'',s'') -a'→⇩τ (m'#ms',s')› ‹kind a' = Q↩⇘p⇙f›
‹ms'' = sourcenode a' # targetnode a' # ms'›
have "∃m ∈ set (targetnode a' # ms'). ∃m'. call_of_return_node m m' ∧
m' ∉ ⌊HRB_slice S⌋⇘CFG⇙"
by(fastforce elim!:silent_move.cases simp:intra_kind_def)
with ‹ms = targetnode a' # ms'› callstack
have False by fastforce
thus ?thesis by simp
qed
qed
qed
qed
qed
lemma silent_moves_called_node_in_slice1_hd_nodestack_in_slice1:
assumes "S,kind ⊢ (m#ms,s) =as⇒⇩τ (m'#ms',s')" and "valid_node m"
and "CFG_node m' ∈ sum_SDG_slice1 nx"
and "∀mx ∈ set ms. ∃mx'. call_of_return_node mx mx' ∧
mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙"
and "∀i < length rs. rs!i ∈ get_return_edges (cs!i)" and "ms = targetnodes rs"
and "valid_return_list rs m" and "length rs = length cs"
obtains as' a as'' where "as = as'@a#as''" and "∃Q r p fs. kind a = Q:r↪⇘p⇙fs"
and "call_of_return_node (hd ms') (sourcenode a)"
and "targetnode a -as''→⇘sl⇙* m'" and "CFG_node (sourcenode a) ∈ sum_SDG_slice1 nx"
| "ms' = ms"
proof(atomize_elim)
from ‹S,kind ⊢ (m#ms,s) =as⇒⇩τ (m'#ms',s')› ‹valid_node m›
‹∀i < length rs. rs!i ∈ get_return_edges (cs!i)› ‹ms = targetnodes rs›
‹valid_return_list rs m› ‹length rs = length cs›
have "m -as→* m'"
by(auto dest:silent_moves_vpa_path[of _ _ _ _ _ _ _ _ _ rs cs]
simp:valid_call_list_def valid_return_list_def targetnodes_def)
from ‹S,kind ⊢ (m#ms,s) =as⇒⇩τ (m'#ms',s')› ‹valid_node m›
‹∀mx ∈ set ms. ∃mx'. call_of_return_node mx mx' ∧ mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
‹∀i < length rs. rs!i ∈ get_return_edges (cs!i)› ‹ms = targetnodes rs›
‹valid_return_list rs m› ‹length rs = length cs›
show "(∃as' a as''. as = as' @ a # as'' ∧ (∃Q r p fs. kind a = Q:r↪⇘p⇙fs) ∧
call_of_return_node (hd ms') (sourcenode a) ∧ targetnode a -as''→⇘sl⇙* m' ∧
CFG_node (sourcenode a) ∈ sum_SDG_slice1 nx) ∨ ms' = ms"
proof(rule silent_moves_call_edge)
fix as' a as'' assume "as = as'@a#as''" and "∃Q r p fs. kind a = Q:r↪⇘p⇙fs"
and "call_of_return_node (hd ms') (sourcenode a)"
and "targetnode a -as''→⇘sl⇙* m'"
from ‹∃Q r p fs. kind a = Q:r↪⇘p⇙fs› obtain Q r p fs
where "kind a = Q:r↪⇘p⇙fs" by blast
from ‹targetnode a -as''→⇘sl⇙* m'› obtain asx where "targetnode a -asx→⇩ι* m'"
by -(erule same_level_path_inner_path)
from ‹m -as→* m'› ‹as = as'@a#as''› have "valid_edge a"
by(fastforce dest:path_split simp:vp_def)
have "m' ≠ (_Exit_)"
proof
assume "m' = (_Exit_)"
have "get_proc (_Exit_) = Main" by(rule get_proc_Exit)
from ‹targetnode a -asx→⇩ι* m'›
have "get_proc (targetnode a) = get_proc m'" by(rule intra_path_get_procs)
with ‹m' = (_Exit_)› ‹get_proc (_Exit_) = Main›
have "get_proc (targetnode a) = Main" by simp
with ‹kind a = Q:r↪⇘p⇙fs› ‹valid_edge a›
have "kind a = Q:r↪⇘Main⇙fs" by(fastforce dest:get_proc_call)
with ‹valid_edge a› show False by(rule Main_no_call_target)
qed
show ?thesis
proof(cases "targetnode a = m'")
case True
with ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs›
have "CFG_node (sourcenode a) s-p→⇘call⇙ CFG_node m'"
by(fastforce intro:sum_SDG_call_edge)
with ‹CFG_node m' ∈ sum_SDG_slice1 nx›
have "CFG_node (sourcenode a) ∈ sum_SDG_slice1 nx" by -(rule call_slice1)
with ‹as = as'@a#as''› ‹∃Q r p fs. kind a = Q:r↪⇘p⇙fs›
‹call_of_return_node (hd ms') (sourcenode a)›
‹targetnode a -as''→⇘sl⇙* m'› show ?thesis by blast
next
case False
with ‹targetnode a -asx→⇩ι* m'› ‹m' ≠ (_Exit_)› ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs›
obtain ns where "CFG_node (targetnode a) cd-ns→⇩d* CFG_node m'"
by(fastforce elim!:in_proc_cdep_SDG_path)
hence "CFG_node (targetnode a) is-ns→⇩d* CFG_node m'"
by(fastforce intro:intra_SDG_path_is_SDG_path cdep_SDG_path_intra_SDG_path)
with ‹CFG_node m' ∈ sum_SDG_slice1 nx›
have "CFG_node (targetnode a) ∈ sum_SDG_slice1 nx"
by -(rule is_SDG_path_slice1)
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs›
have "CFG_node (sourcenode a) s-p→⇘call⇙ CFG_node (targetnode a)"
by(fastforce intro:sum_SDG_call_edge)
with ‹CFG_node (targetnode a) ∈ sum_SDG_slice1 nx›
have "CFG_node (sourcenode a) ∈ sum_SDG_slice1 nx" by -(rule call_slice1)
with ‹as = as'@a#as''› ‹∃Q r p fs. kind a = Q:r↪⇘p⇙fs›
‹call_of_return_node (hd ms') (sourcenode a)›
‹targetnode a -as''→⇘sl⇙* m'› show ?thesis by blast
qed
next
assume "ms' = ms" thus ?thesis by simp
qed
qed
lemma silent_moves_called_node_in_slice1_nodestack_in_slice1:
"⟦S,kind ⊢ (m#ms,s) =as⇒⇩τ (m'#ms',s'); valid_node m;
CFG_node m' ∈ sum_SDG_slice1 nx; nx ∈ S;
∀mx ∈ set ms. ∃mx'. call_of_return_node mx mx' ∧ mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙;
∀i < length rs. rs!i ∈ get_return_edges (cs!i); ms = targetnodes rs;
valid_return_list rs m; length rs = length cs⟧
⟹ ∀mx ∈ set ms'. ∃mx'. call_of_return_node mx mx' ∧ mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙"
proof(induct ms' arbitrary:as m' s')
case (Cons mx msx)
note IH = ‹⋀as m' s'. ⟦S,kind ⊢ (m#ms,s) =as⇒⇩τ (m' # msx,s'); valid_node m;
CFG_node m' ∈ sum_SDG_slice1 nx; nx ∈ S;
∀mx∈set ms. ∃mx'. call_of_return_node mx mx' ∧ mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙;
∀i<length rs. rs ! i ∈ get_return_edges (cs ! i); ms = targetnodes rs;
valid_return_list rs m; length rs = length cs⟧
⟹ ∀mx∈set msx. ∃mx'. call_of_return_node mx mx' ∧ mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
from ‹S,kind ⊢ (m#ms,s) =as⇒⇩τ (m' # mx # msx,s')› ‹valid_node m›
‹CFG_node m' ∈ sum_SDG_slice1 nx›
‹∀mx ∈ set ms. ∃mx'. call_of_return_node mx mx' ∧ mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
‹∀i < length rs. rs!i ∈ get_return_edges (cs!i)› ‹ms = targetnodes rs›
‹valid_return_list rs m› ‹length rs = length cs›
show ?case
proof(rule silent_moves_called_node_in_slice1_hd_nodestack_in_slice1)
fix as' a as'' assume "as = as'@a#as''" and "∃Q r p fs. kind a = Q:r↪⇘p⇙fs"
and "call_of_return_node (hd (mx # msx)) (sourcenode a)"
and "CFG_node (sourcenode a) ∈ sum_SDG_slice1 nx"
and "targetnode a -as''→⇘sl⇙* m'"
from ‹CFG_node (sourcenode a) ∈ sum_SDG_slice1 nx› ‹nx ∈ S›
have "sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙"
by(fastforce intro:combSlice_refl simp:SDG_to_CFG_set_def HRB_slice_def)
from ‹S,kind ⊢ (m#ms,s) =as⇒⇩τ (m' # mx # msx,s')› ‹as = as'@a#as''›
obtain xs x where "S,kind ⊢ (m#ms,s) =as'⇒⇩τ (xs,x)"
and "S,kind ⊢ (xs,x) =a#as''⇒⇩τ (m' # mx # msx,s')"
by(fastforce elim:silent_moves_split)
from ‹S,kind ⊢ (xs,x) =a#as''⇒⇩τ (m' # mx # msx,s')›
obtain ys y where "S,kind ⊢ (xs,x) -a→⇩τ (ys,y)"
and "S,kind ⊢ (ys,y) =as''⇒⇩τ (m' # mx # msx,s')"
by(fastforce elim:silent_moves.cases)
from ‹S,kind ⊢ (xs,x) -a→⇩τ (ys,y)› ‹∃Q r p fs. kind a = Q:r↪⇘p⇙fs›
obtain xs' a' where "xs = sourcenode a#xs'"
and "ys = targetnode a#targetnode a'#xs'"
apply - apply(erule silent_move.cases) apply(auto simp:intra_kind_def)
by(cases xs,auto)+
from ‹S,kind ⊢ (ys,y) =as''⇒⇩τ (m' # mx # msx,s')›
‹ys = targetnode a#targetnode a'#xs'› ‹targetnode a -as''→⇘sl⇙* m'›
have "mx = targetnode a'" and "xs' = msx"
by(auto dest:silent_moves_same_level_path)
with ‹xs = sourcenode a#xs'› ‹S,kind ⊢ (m#ms,s) =as'⇒⇩τ (xs,x)›
have "S,kind ⊢ (m#ms,s) =as'⇒⇩τ (sourcenode a#msx,x)" by simp
from IH[OF ‹S,kind ⊢ (m#ms,s) =as'⇒⇩τ (sourcenode a#msx,x)›
‹valid_node m› ‹CFG_node (sourcenode a) ∈ sum_SDG_slice1 nx› ‹nx ∈ S›
‹∀mx ∈ set ms. ∃mx'. call_of_return_node mx mx' ∧ mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
‹∀i < length rs. rs!i ∈ get_return_edges (cs!i)› ‹ms = targetnodes rs›
‹valid_return_list rs m› ‹length rs = length cs›]
have callstack:"∀mx∈set msx.
∃mx'. call_of_return_node mx mx' ∧ mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙" .
with ‹as = as'@a#as''› ‹call_of_return_node (hd (mx # msx)) (sourcenode a)›
‹sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙› show ?thesis by fastforce
next
assume "mx # msx = ms"
with ‹∀mx ∈ set ms. ∃mx'. call_of_return_node mx mx' ∧ mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
show ?thesis by fastforce
qed
qed simp
lemma silent_moves_slice_intra_path:
assumes "S,slice_kind S ⊢ (m#ms,s) =as⇒⇩τ (m'#ms',s')"
and "∀mx ∈ set ms. ∃mx'. call_of_return_node mx mx' ∧ mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙"
shows "∀a ∈ set as. intra_kind (kind a)"
proof(rule ccontr)
assume "¬ (∀a∈set as. intra_kind (kind a))"
hence "∃a ∈ set as. ¬ intra_kind (kind a)" by fastforce
then obtain asx ax asx' where "as = asx@ax#asx'"
and "∀a∈set asx. intra_kind (kind a)" and "¬ intra_kind (kind ax)"
by(fastforce elim!:split_list_first_propE)
from ‹S,slice_kind S ⊢ (m#ms,s) =as⇒⇩τ (m'#ms',s')› ‹as = asx@ax#asx'›
obtain msx sx msx' sx' where "S,slice_kind S ⊢ (m#ms,s) =asx⇒⇩τ (msx,sx)"
and "S,slice_kind S ⊢ (msx,sx) -ax→⇩τ (msx',sx')"
and "S,slice_kind S ⊢ (msx',sx') =asx'⇒⇩τ (m'#ms',s')"
by(auto elim!:silent_moves_split elim:silent_moves.cases)
from ‹S,slice_kind S ⊢ (msx,sx) -ax→⇩τ (msx',sx')› obtain xs
where [simp]:"msx = sourcenode ax#xs" by(cases msx)(auto elim:silent_move.cases)
from ‹S,slice_kind S ⊢ (m#ms,s) =asx⇒⇩τ (msx,sx)› ‹∀a∈set asx. intra_kind (kind a)›
have [simp]:"xs = ms" by(fastforce dest:silent_moves_intra_path)
show False
proof(cases "kind ax" rule:edge_kind_cases)
case Intra with ‹¬ intra_kind (kind ax)› show False by simp
next
case (Call Q r p fs)
with ‹S,slice_kind S ⊢ (msx,sx) -ax→⇩τ (msx',sx')›
‹∀mx ∈ set ms. ∃mx'. call_of_return_node mx mx' ∧ mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
have "sourcenode ax ∉ ⌊HRB_slice S⌋⇘CFG⇙" and "pred (slice_kind S ax) sx"
by(auto elim!:silent_move.cases simp:intra_kind_def)
from ‹sourcenode ax ∉ ⌊HRB_slice S⌋⇘CFG⇙› ‹kind ax = Q:r↪⇘p⇙fs›
have "slice_kind S ax = (λcf. False):r↪⇘p⇙fs"
by(rule slice_kind_Call)
with ‹pred (slice_kind S ax) sx› show False by(cases sx) auto
next
case (Return Q p f)
with ‹S,slice_kind S ⊢ (msx,sx) -ax→⇩τ (msx',sx')›
‹∀mx ∈ set ms. ∃mx'. call_of_return_node mx mx' ∧ mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
show False by(fastforce elim!:silent_move.cases simp:intra_kind_def)
qed
qed
lemma silent_moves_slice_keeps_state:
assumes "S,slice_kind S ⊢ (m#ms,s) =as⇒⇩τ (m'#ms',s')"
and "∀mx ∈ set ms. ∃mx'. call_of_return_node mx mx' ∧ mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙"
shows "s = s'"
proof -
from assms have "∀a ∈ set as. intra_kind (kind a)"
by(rule silent_moves_slice_intra_path)
with assms show ?thesis
proof(induct S "slice_kind S" "m#ms" s as "m'#ms'" s'
arbitrary:m rule:silent_moves.induct)
case (silent_moves_Nil sx n⇩c) thus ?case by simp
next
case (silent_moves_Cons S sx a msx' sx' as s'')
note IH = ‹⋀m.
⟦msx' = m # ms;
∀mx∈set ms. ∃mx'. call_of_return_node mx mx' ∧ mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙;
∀a∈set as. intra_kind (kind a)⟧ ⟹ sx' = s''›
note callstack = ‹∀mx∈set ms. ∃mx'. call_of_return_node mx mx' ∧
mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
from ‹∀a∈set (a # as). intra_kind (kind a)› have "intra_kind (kind a)"
and "∀a∈set as. intra_kind (kind a)" by simp_all
from ‹S,slice_kind S ⊢ (m # ms,sx) -a→⇩τ (msx',sx')› ‹intra_kind (kind a)›
callstack
have [simp]:"msx' = targetnode a#ms" and "sx' = transfer (slice_kind S a) sx"
and "sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙" and "valid_edge a" and "sx ≠ []"
by(auto elim!:silent_move.cases simp:intra_kind_def)
from IH[OF ‹msx' = targetnode a#ms› callstack ‹∀a∈set as. intra_kind (kind a)›]
have "sx' = s''" .
from ‹intra_kind (kind a)›
have "sx = sx'"
proof(cases "kind a")
case (UpdateEdge f')
with ‹sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙›
have "slice_kind S a = ⇑id" by(rule slice_kind_Upd)
with ‹sx' = transfer (slice_kind S a) sx› ‹sx ≠ []›
show ?thesis by(cases sx) auto
next
case (PredicateEdge Q)
with ‹sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙› ‹valid_edge a›
obtain Q' where "slice_kind S a = (Q')⇩√"
by -(erule kind_Predicate_notin_slice_slice_kind_Predicate)
with ‹sx' = transfer (slice_kind S a) sx› ‹sx ≠ []›
show ?thesis by(cases sx) auto
qed (auto simp:intra_kind_def)
with ‹sx' = s''› show ?case by simp
qed
qed
subsection ‹Definition of ‹slice_edges››
definition slice_edge :: "'node SDG_node set ⇒ 'edge list ⇒ 'edge ⇒ bool"
where "slice_edge S cs a ≡ (∀c ∈ set cs. sourcenode c ∈ ⌊HRB_slice S⌋⇘CFG⇙) ∧
(case (kind a) of Q↩⇘p⇙f ⇒ True | _ ⇒ sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙)"
lemma silent_move_no_slice_edge:
"⟦S,f ⊢ (ms,s) -a→⇩τ (ms',s'); tl ms = targetnodes rs; length rs = length cs;
∀i<length cs. call_of_return_node (tl ms!i) (sourcenode (cs!i))⟧
⟹ ¬ slice_edge S cs a"
proof(induct rule:silent_move.induct)
case (silent_move_intra f a s s' ms S ms')
note disj = ‹(∃m∈set (tl ms). ∃m'. call_of_return_node m m' ∧ m' ∉ ⌊HRB_slice S⌋⇘CFG⇙)
∨ hd ms ∉ ⌊HRB_slice S⌋⇘CFG⇙›
from ‹pred (f a) s› ‹length ms = length s› obtain x xs where "ms = x#xs"
by(cases ms) auto
from ‹length rs = length cs› ‹tl ms = targetnodes rs›
have "length (tl ms) = length cs" by(simp add:targetnodes_def)
from disj show ?case
proof
assume "∃m∈set (tl ms). ∃m'. call_of_return_node m m' ∧ m' ∉ ⌊HRB_slice S⌋⇘CFG⇙"
with ‹∀i<length cs. call_of_return_node (tl ms ! i) (sourcenode (cs ! i))›
‹length (tl ms) = length cs›
have "∃c ∈ set cs. sourcenode c ∉ ⌊HRB_slice S⌋⇘CFG⇙"
apply(auto simp:in_set_conv_nth)
by(erule_tac x="i" in allE) auto
thus ?thesis by(auto simp:slice_edge_def)
next
assume "hd ms ∉ ⌊HRB_slice S⌋⇘CFG⇙"
with ‹hd ms = sourcenode a› ‹intra_kind (kind a)›
show ?case by(auto simp:slice_edge_def simp:intra_kind_def)
qed
next
case (silent_move_call f a s s' Q r p fs a' ms S ms')
note disj = ‹(∃m∈set (tl ms). ∃m'. call_of_return_node m m' ∧ m' ∉ ⌊HRB_slice S⌋⇘CFG⇙)
∨ hd ms ∉ ⌊HRB_slice S⌋⇘CFG⇙›
from ‹pred (f a) s› ‹length ms = length s› obtain x xs where "ms = x#xs"
by(cases ms) auto
from ‹length rs = length cs› ‹tl ms = targetnodes rs›
have "length (tl ms) = length cs" by(simp add:targetnodes_def)
from disj show ?case
proof
assume "∃m∈set (tl ms). ∃m'. call_of_return_node m m' ∧ m' ∉ ⌊HRB_slice S⌋⇘CFG⇙"
with ‹∀i<length cs. call_of_return_node (tl ms ! i) (sourcenode (cs ! i))›
‹length (tl ms) = length cs›
have "∃c ∈ set cs. sourcenode c ∉ ⌊HRB_slice S⌋⇘CFG⇙"
apply(auto simp:in_set_conv_nth)
by(erule_tac x="i" in allE) auto
thus ?thesis by(auto simp:slice_edge_def)
next
assume "hd ms ∉ ⌊HRB_slice S⌋⇘CFG⇙"
with ‹hd ms = sourcenode a› ‹kind a = Q:r↪⇘p⇙fs›
show ?case by(auto simp:slice_edge_def)
qed
next
case (silent_move_return f a s s' Q p f' ms S ms')
from ‹pred (f a) s› ‹length ms = length s› obtain x xs where "ms = x#xs"
by(cases ms) auto
from ‹length rs = length cs› ‹tl ms = targetnodes rs›
have "length (tl ms) = length cs" by(simp add:targetnodes_def)
from ‹∀i<length cs. call_of_return_node (tl ms ! i) (sourcenode (cs ! i))›
‹∃m∈set (tl ms). ∃m'. call_of_return_node m m' ∧ m' ∉ ⌊HRB_slice S⌋⇘CFG⇙›
‹length (tl ms) = length cs›
have "∃c ∈ set cs. sourcenode c ∉ ⌊HRB_slice S⌋⇘CFG⇙"
apply(auto simp:in_set_conv_nth)
by(erule_tac x="i" in allE) auto
thus ?case by(auto simp:slice_edge_def)
qed
lemma observable_move_slice_edge:
"⟦S,f ⊢ (ms,s) -a→ (ms',s'); tl ms = targetnodes rs; length rs = length cs;
∀i<length cs. call_of_return_node (tl ms!i) (sourcenode (cs!i))⟧
⟹ slice_edge S cs a"
proof(induct rule:observable_move.induct)
case (observable_move_intra f a s s' ms S ms')
from ‹pred (f a) s› ‹length ms = length s› obtain x xs where "ms = x#xs"
by(cases ms) auto
from ‹length rs = length cs› ‹tl ms = targetnodes rs›
have "length (tl ms) = length cs" by(simp add:targetnodes_def)
with ‹∀m∈set (tl ms). ∃m'. call_of_return_node m m' ∧ m' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
‹∀i<length cs. call_of_return_node (tl ms!i) (sourcenode (cs!i))›
have "∀c ∈ set cs. sourcenode c ∈ ⌊HRB_slice S⌋⇘CFG⇙"
apply(auto simp:in_set_conv_nth)
by(erule_tac x="i" in allE) auto
with ‹hd ms = sourcenode a› ‹hd ms ∈ ⌊HRB_slice S⌋⇘CFG⇙› ‹intra_kind (kind a)›
show ?case by(auto simp:slice_edge_def simp:intra_kind_def)
next
case (observable_move_call f a s s' Q r p fs a' ms S ms')
from ‹pred (f a) s› ‹length ms = length s› obtain x xs where "ms = x#xs"
by(cases ms) auto
from ‹length rs = length cs› ‹tl ms = targetnodes rs›
have "length (tl ms) = length cs" by(simp add:targetnodes_def)
with ‹∀m∈set (tl ms). ∃m'. call_of_return_node m m' ∧ m' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
‹∀i<length cs. call_of_return_node (tl ms!i) (sourcenode (cs!i))›
have "∀c ∈ set cs. sourcenode c ∈ ⌊HRB_slice S⌋⇘CFG⇙"
apply(auto simp:in_set_conv_nth)
by(erule_tac x="i" in allE) auto
with ‹hd ms = sourcenode a› ‹hd ms ∈ ⌊HRB_slice S⌋⇘CFG⇙› ‹kind a = Q:r↪⇘p⇙fs›
show ?case by(auto simp:slice_edge_def)
next
case (observable_move_return f a s s' Q p f' ms S ms')
from ‹pred (f a) s› ‹length ms = length s› obtain x xs where "ms = x#xs"
by(cases ms) auto
from ‹length rs = length cs› ‹tl ms = targetnodes rs›
have "length (tl ms) = length cs" by(simp add:targetnodes_def)
with ‹∀m∈set (tl ms). ∃m'. call_of_return_node m m' ∧ m' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
‹∀i<length cs. call_of_return_node (tl ms!i) (sourcenode (cs!i))›
have "∀c ∈ set cs. sourcenode c ∈ ⌊HRB_slice S⌋⇘CFG⇙"
apply(auto simp:in_set_conv_nth)
by(erule_tac x="i" in allE) auto
with ‹kind a = Q↩⇘p⇙f'› show ?case by(auto simp:slice_edge_def)
qed
function slice_edges :: "'node SDG_node set ⇒ 'edge list ⇒ 'edge list ⇒ 'edge list"
where "slice_edges S cs [] = []"
| "slice_edge S cs a ⟹
slice_edges S cs (a#as) = a#slice_edges S (upd_cs cs [a]) as"
| "¬ slice_edge S cs a ⟹
slice_edges S cs (a#as) = slice_edges S (upd_cs cs [a]) as"
by(atomize_elim)(auto,case_tac b,auto)
termination by(lexicographic_order)
lemma slice_edges_Append:
"⟦slice_edges S cs as = as'; slice_edges S (upd_cs cs as) asx = asx'⟧
⟹ slice_edges S cs (as@asx) = as'@asx'"
proof(induct as arbitrary:cs as')
case Nil thus ?case by simp
next
case (Cons x xs)
note IH = ‹⋀cs as'. ⟦slice_edges S cs xs = as';
slice_edges S (upd_cs cs xs) asx = asx'⟧
⟹ slice_edges S cs (xs @ asx) = as' @ asx'›
from ‹slice_edges S (upd_cs cs (x # xs)) asx = asx'›
have "slice_edges S (upd_cs (upd_cs cs [x]) xs) asx = asx'"
by(cases "kind x")(auto,cases cs,auto)
show ?case
proof(cases "slice_edge S cs x")
case True
with ‹slice_edges S cs (x # xs) = as'›
have "x#slice_edges S (upd_cs cs [x]) xs = as'" by simp
then obtain xs' where "as' = x#xs'"
and "slice_edges S (upd_cs cs [x]) xs = xs'" by(cases as') auto
from IH[OF ‹slice_edges S (upd_cs cs [x]) xs = xs'›
‹slice_edges S (upd_cs (upd_cs cs [x]) xs) asx = asx'›]
have "slice_edges S (upd_cs cs [x]) (xs @ asx) = xs' @ asx'" .
with True ‹as' = x#xs'› show ?thesis by simp
next
case False
with ‹slice_edges S cs (x # xs) = as'›
have "slice_edges S (upd_cs cs [x]) xs = as'" by simp
from IH[OF this ‹slice_edges S (upd_cs (upd_cs cs [x]) xs) asx = asx'›]
have "slice_edges S (upd_cs cs [x]) (xs @ asx) = as' @ asx'" .
with False show ?thesis by simp
qed
qed
lemma slice_edges_Nil_split:
"slice_edges S cs (as@as') = []
⟹ slice_edges S cs as = [] ∧ slice_edges S (upd_cs cs as) as' = []"
apply(induct as arbitrary:cs)
apply clarsimp
apply(case_tac "slice_edge S cs a") apply auto
apply(case_tac "kind a") apply auto
apply(case_tac cs) apply auto
done
lemma slice_intra_edges_no_nodes_in_slice:
"⟦slice_edges S cs as = []; ∀a ∈ set as. intra_kind (kind a);
∀c ∈ set cs. sourcenode c ∈ ⌊HRB_slice S⌋⇘CFG⇙⟧
⟹ ∀nx ∈ set(sourcenodes as). nx ∉ ⌊HRB_slice S⌋⇘CFG⇙"
proof(induct as)
case Nil thus ?case by(fastforce simp:sourcenodes_def)
next
case (Cons a' as')
note IH = ‹ ⟦slice_edges S cs as' = []; ∀a∈set as'. intra_kind (kind a);
∀c∈set cs. sourcenode c ∈ ⌊HRB_slice S⌋⇘CFG⇙⟧
⟹ ∀nx∈set (sourcenodes as'). nx ∉ ⌊HRB_slice S⌋⇘CFG⇙›
from ‹∀a∈set (a' # as'). intra_kind (kind a)›
have "intra_kind (kind a')" and "∀a∈set as'. intra_kind (kind a)" by simp_all
from ‹slice_edges S cs (a' # as') = []› ‹intra_kind (kind a')›
‹∀c∈set cs. sourcenode c ∈ ⌊HRB_slice S⌋⇘CFG⇙›
have "sourcenode a' ∉ ⌊HRB_slice S⌋⇘CFG⇙" and "slice_edges S cs as' = []"
by(cases "slice_edge S cs a'",auto simp:intra_kind_def slice_edge_def)+
from IH[OF ‹slice_edges S cs as' = []› ‹∀a∈set as'. intra_kind (kind a)›
‹∀c∈set cs. sourcenode c ∈ ⌊HRB_slice S⌋⇘CFG⇙›]
have "∀nx∈set (sourcenodes as'). nx ∉ ⌊HRB_slice S⌋⇘CFG⇙" .
with ‹sourcenode a' ∉ ⌊HRB_slice S⌋⇘CFG⇙› show ?case by(simp add:sourcenodes_def)
qed
lemma silent_moves_no_slice_edges:
"⟦S,f ⊢ (ms,s) =as⇒⇩τ (ms',s'); tl ms = targetnodes rs; length rs = length cs;
∀i<length cs. call_of_return_node (tl ms!i) (sourcenode (cs!i))⟧
⟹ slice_edges S cs as = [] ∧ (∃rs'. tl ms' = targetnodes rs' ∧
length rs' = length (upd_cs cs as) ∧ (∀i<length (upd_cs cs as).
call_of_return_node (tl ms'!i) (sourcenode ((upd_cs cs as)!i))))"
proof(induct arbitrary:rs cs rule:silent_moves.induct)
case (silent_moves_Cons S f ms s a ms' s' as ms'' s'')
from ‹S,f ⊢ (ms,s) -a→⇩τ (ms',s')› ‹tl ms = targetnodes rs› ‹length rs = length cs›
‹∀i<length cs. call_of_return_node (tl ms ! i) (sourcenode (cs ! i))›
have "¬ slice_edge S cs a" by(rule silent_move_no_slice_edge)
with silent_moves_Cons show ?case
proof(induct rule:silent_move.induct)
case (silent_move_intra f a s s' ms S ms')
note IH = ‹⋀rs cs. ⟦tl ms' = targetnodes rs; length rs = length cs;
∀i<length cs. call_of_return_node (tl ms' ! i) (sourcenode (cs ! i))⟧
⟹ slice_edges S cs as = [] ∧ (∃rs'. tl ms'' = targetnodes rs' ∧
length rs' = length (upd_cs cs as) ∧ (∀i<length (upd_cs cs as).
call_of_return_node (tl ms'' ! i) (sourcenode (upd_cs cs as ! i))))›
from ‹ms' = targetnode a # tl ms› ‹tl ms = targetnodes rs›
have "tl ms' = targetnodes rs" by simp
from ‹ms' = targetnode a # tl ms› ‹tl ms = targetnodes rs›
‹∀i<length cs. call_of_return_node (tl ms ! i) (sourcenode (cs ! i))›
have "∀i<length cs. call_of_return_node (tl ms' ! i) (sourcenode (cs ! i))"
by simp
from IH[OF ‹tl ms' = targetnodes rs› ‹length rs = length cs› this]
have "slice_edges S cs as = []"
and "∃rs'. tl ms'' = targetnodes rs' ∧ length rs' = length (upd_cs cs as) ∧
(∀i<length (upd_cs cs as).
call_of_return_node (tl ms'' ! i) (sourcenode (upd_cs cs as ! i)))" by simp_all
with ‹intra_kind (kind a)› ‹¬ slice_edge S cs a›
show ?case by(fastforce simp:intra_kind_def)
next
case (silent_move_call f a s s' Q r p fs a' ms S ms')
note IH = ‹⋀rs cs. ⟦tl ms' = targetnodes rs; length rs = length cs;
∀i<length cs. call_of_return_node (tl ms' ! i) (sourcenode (cs ! i))⟧
⟹ slice_edges S cs as = [] ∧ (∃rs'. tl ms'' = targetnodes rs' ∧
length rs' = length (upd_cs cs as) ∧ (∀i<length (upd_cs cs as).
call_of_return_node (tl ms'' ! i) (sourcenode (upd_cs cs as ! i))))›
from ‹tl ms = targetnodes rs› ‹ms' = targetnode a # targetnode a' # tl ms›
have "tl ms' = targetnodes (a'#rs)" by(simp add:targetnodes_def)
from ‹length rs = length cs› have "length (a'#rs) = length (a#cs)" by simp
from ‹valid_edge a'› ‹valid_edge a› ‹a' ∈ get_return_edges a›
have "return_node (targetnode a')" by(fastforce simp:return_node_def)
with ‹valid_edge a› ‹valid_edge a'› ‹a' ∈ get_return_edges a›
have "call_of_return_node (targetnode a') (sourcenode a)"
by(simp add:call_of_return_node_def) blast
with ‹∀i<length cs. call_of_return_node (tl ms ! i) (sourcenode (cs ! i))›
‹ms' = targetnode a # targetnode a' # tl ms›
have "∀i<length (a#cs).
call_of_return_node (tl ms' ! i) (sourcenode ((a#cs) ! i))"
by auto (case_tac i,auto)
from IH[OF ‹tl ms' = targetnodes (a'#rs)› ‹length (a'#rs) = length (a#cs)› this]
have "slice_edges S (a # cs) as = []"
and "∃rs'. tl ms'' = targetnodes rs' ∧
length rs' = length (upd_cs (a # cs) as) ∧
(∀i<length (upd_cs (a # cs) as).
call_of_return_node (tl ms'' ! i) (sourcenode (upd_cs (a # cs) as ! i)))"
by simp_all
with ‹¬ slice_edge S cs a› ‹kind a = Q:r↪⇘p⇙fs› show ?case by simp
next
case (silent_move_return f a s s' Q p f' ms S ms')
note IH = ‹⋀rs cs. ⟦tl ms' = targetnodes rs; length rs = length cs;
∀i<length cs. call_of_return_node (tl ms' ! i) (sourcenode (cs ! i))⟧
⟹ slice_edges S cs as = [] ∧ (∃rs'. tl ms'' = targetnodes rs' ∧
length rs' = length (upd_cs cs as) ∧ (∀i<length (upd_cs cs as).
call_of_return_node (tl ms'' ! i) (sourcenode (upd_cs cs as ! i))))›
from ‹length s = Suc (length s')› ‹s' ≠ []› ‹length ms = length s› ‹ms' = tl ms›
obtain x xs where [simp]:"ms' = x#xs" by(cases ms)(auto,case_tac ms',auto)
from ‹ms' = tl ms› ‹tl ms = targetnodes rs› obtain r' rs' where "rs = r'#rs'"
and "x = targetnode r'" and "tl ms' = targetnodes rs'"
by(cases rs)(auto simp:targetnodes_def)
from ‹length rs = length cs› ‹rs = r'#rs'› obtain c' cs' where "cs = c'#cs'"
and "length rs' = length cs'" by(cases cs) auto
from ‹∀i<length cs. call_of_return_node (tl ms ! i) (sourcenode (cs ! i))›
‹cs = c'#cs'› ‹ms' = tl ms›
have "∀i<length cs'. call_of_return_node (tl ms' ! i) (sourcenode (cs' ! i))"
by auto(erule_tac x="Suc i" in allE,cases "tl ms",auto)
from IH[OF ‹tl ms' = targetnodes rs'› ‹length rs' = length cs'› this]
have "slice_edges S cs' as = []" and "∃rs'. tl ms'' = targetnodes rs' ∧
length rs' = length (upd_cs cs' as) ∧ (∀i<length (upd_cs cs' as).
call_of_return_node (tl ms'' ! i) (sourcenode (upd_cs cs' as ! i)))"
by simp_all
with ‹¬ slice_edge S cs a› ‹kind a = Q↩⇘p⇙f'› ‹cs = c'#cs'›
show ?case by simp
qed
qed fastforce
lemma observable_moves_singular_slice_edge:
"⟦S,f ⊢ (ms,s) =as⇒ (ms',s'); tl ms = targetnodes rs; length rs = length cs;
∀i<length cs. call_of_return_node (tl ms!i) (sourcenode (cs!i))⟧
⟹ slice_edges S cs as = [last as]"
proof(induct rule:observable_moves.induct)
case (observable_moves_snoc S f ms s as ms' s' a ms'' s'')
from ‹S,f ⊢ (ms,s) =as⇒⇩τ (ms',s')› ‹tl ms = targetnodes rs› ‹length rs = length cs›
‹∀i<length cs. call_of_return_node (tl ms ! i) (sourcenode (cs ! i))›
obtain rs' where "slice_edges S cs as = []"
and "tl ms' = targetnodes rs'" and "length rs' = length (upd_cs cs as)"
and "∀i<length (upd_cs cs as).
call_of_return_node (tl ms'!i) (sourcenode ((upd_cs cs as)!i))"
by(fastforce dest!:silent_moves_no_slice_edges)
from ‹S,f ⊢ (ms',s') -a→ (ms'',s'')› this
have "slice_edge S (upd_cs cs as) a" by -(rule observable_move_slice_edge)
with ‹slice_edges S cs as = []› have "slice_edges S cs (as @ [a]) = []@[a]"
by(fastforce intro:slice_edges_Append)
thus ?case by simp
qed
lemma silent_moves_nonempty_nodestack_False:
assumes "S,kind ⊢ ([m],[cf]) =as⇒⇩τ (m'#ms',s')" and "valid_node m"
and "ms' ≠ []" and "CFG_node m' ∈ sum_SDG_slice1 nx" and "nx ∈ S"
shows False
proof -
from assms(1-4) have "slice_edges S [] as ≠ []"
proof(induct ms' arbitrary:as m' s')
case (Cons mx msx)
note IH = ‹⋀as m' s'. ⟦S,kind ⊢ ([m],[cf]) =as⇒⇩τ (m' # msx,s'); valid_node m;
msx ≠ []; CFG_node m' ∈ sum_SDG_slice1 nx⟧
⟹ slice_edges S [] as ≠ []›
from ‹S,kind ⊢ ([m],[cf]) =as⇒⇩τ (m' # mx # msx,s')› ‹valid_node m›
‹CFG_node m' ∈ sum_SDG_slice1 nx›
obtain as' a as'' where "as = as'@a#as''" and "∃Q r p fs. kind a = Q:r↪⇘p⇙fs"
and "call_of_return_node mx (sourcenode a)"
and "CFG_node (sourcenode a) ∈ sum_SDG_slice1 nx"
and "targetnode a -as''→⇘sl⇙* m'"
by(fastforce elim!:silent_moves_called_node_in_slice1_hd_nodestack_in_slice1
[of _ _ _ _ _ _ _ _ _ "[]" "[]"] simp:targetnodes_def valid_return_list_def)
from ‹S,kind ⊢ ([m],[cf]) =as⇒⇩τ (m' # mx # msx,s')› ‹as = as'@a#as''›
obtain xs x where "S,kind ⊢ ([m],[cf]) =as'⇒⇩τ (xs,x)"
and "S,kind ⊢ (xs,x) =a#as''⇒⇩τ (m' # mx # msx,s')"
by(fastforce elim:silent_moves_split)
from ‹S,kind ⊢ (xs,x) =a#as''⇒⇩τ (m' # mx # msx,s')›
obtain ys y where "S,kind ⊢ (xs,x) -a→⇩τ (ys,y)"
and "S,kind ⊢ (ys,y) =as''⇒⇩τ (m' # mx # msx,s')"
by(fastforce elim:silent_moves.cases)
from ‹S,kind ⊢ (xs,x) -a→⇩τ (ys,y)› ‹∃Q r p fs. kind a = Q:r↪⇘p⇙fs›
obtain xs' a' where "xs = sourcenode a#xs'"
and "ys = targetnode a#targetnode a'#xs'"
apply - apply(erule silent_move.cases) apply(auto simp:intra_kind_def)
by(cases xs,auto)+
from ‹S,kind ⊢ (ys,y) =as''⇒⇩τ (m' # mx # msx,s')›
‹ys = targetnode a#targetnode a'#xs'› ‹targetnode a -as''→⇘sl⇙* m'›
have "mx = targetnode a'" and "xs' = msx"
by(auto dest:silent_moves_same_level_path)
with ‹xs = sourcenode a#xs'› ‹S,kind ⊢ ([m],[cf]) =as'⇒⇩τ (xs,x)›
have "S,kind ⊢ ([m],[cf]) =as'⇒⇩τ (sourcenode a#msx,x)" by simp
show ?case
proof(cases "msx = []")
case True
from ‹S,kind ⊢ ([m],[cf]) =as'⇒⇩τ (sourcenode a#msx,x)›
obtain rs' where "msx = targetnodes rs' ∧ length rs' = length (upd_cs [] as')"
by(fastforce dest!:silent_moves_no_slice_edges[where cs="[]" and rs="[]"]
simp:targetnodes_def)
with True have "upd_cs [] as' = []" by(cases rs')(auto simp:targetnodes_def)
with ‹CFG_node (sourcenode a) ∈ sum_SDG_slice1 nx› ‹nx ∈ S›
have "slice_edge S (upd_cs [] as') a"
by(cases "kind a",auto intro:combSlice_refl
simp:slice_edge_def SDG_to_CFG_set_def HRB_slice_def)
hence "slice_edges S (upd_cs [] as') (a#as'') ≠ []" by simp
with ‹as = as'@a#as''› show ?thesis by(fastforce dest:slice_edges_Nil_split)
next
case False
from IH[OF ‹S,kind ⊢ ([m],[cf]) =as'⇒⇩τ (sourcenode a#msx,x)›
‹valid_node m› this ‹CFG_node (sourcenode a) ∈ sum_SDG_slice1 nx›]
have "slice_edges S [] as' ≠ []" .
with ‹as = as'@a#as''› show ?thesis by(fastforce dest:slice_edges_Nil_split)
qed
qed simp
moreover
from ‹S,kind ⊢ ([m],[cf]) =as⇒⇩τ (m'#ms',s')› have "slice_edges S [] as = []"
by(fastforce dest!:silent_moves_no_slice_edges[where cs="[]" and rs="[]"]
simp:targetnodes_def)
ultimately show False by simp
qed
lemma transfers_intra_slice_kinds_slice_edges:
"⟦∀a ∈ set as. intra_kind (kind a); ∀c ∈ set cs. sourcenode c ∈ ⌊HRB_slice S⌋⇘CFG⇙⟧
⟹ transfers (slice_kinds S (slice_edges S cs as)) s =
transfers (slice_kinds S as) s"
proof(induct as arbitrary:s)
case Nil thus ?case by(simp add:slice_kinds_def)
next
case (Cons a' as')
note IH = ‹⋀s. ⟦∀a∈set as'. intra_kind (kind a);
∀c∈set cs. sourcenode c ∈ ⌊HRB_slice S⌋⇘CFG⇙⟧ ⟹
transfers (slice_kinds S (slice_edges S cs as')) s =
transfers (slice_kinds S as') s›
from ‹∀a∈set (a' # as'). intra_kind (kind a)›
have "intra_kind (kind a')" and "∀a∈set as'. intra_kind (kind a)"
by simp_all
show ?case
proof(cases "slice_edge S cs a'")
case True
with ‹intra_kind (kind a')›
have eq:"transfers (slice_kinds S (slice_edges S cs (a'#as'))) s
= transfers (slice_kinds S (slice_edges S cs as'))
(transfer (slice_kind S a') s)"
by(cases "kind a'")(auto simp:slice_kinds_def intra_kind_def)
have "transfers (slice_kinds S (a'#as')) s
= transfers (slice_kinds S as') (transfer (slice_kind S a') s)"
by(simp add:slice_kinds_def)
with eq IH[OF ‹∀a∈set as'. intra_kind (kind a)›
‹∀c∈set cs. sourcenode c ∈ ⌊HRB_slice S⌋⇘CFG⇙›,
of "transfer (slice_kind S a') s"]
show ?thesis by simp
next
case False
with ‹intra_kind (kind a')›
have eq:"transfers (slice_kinds S (slice_edges S cs (a'#as'))) s
= transfers (slice_kinds S (slice_edges S cs as')) s"
by(cases "kind a'")(auto simp:slice_kinds_def intra_kind_def)
from False ‹intra_kind (kind a')› ‹∀c∈set cs. sourcenode c ∈ ⌊HRB_slice S⌋⇘CFG⇙›
have "sourcenode a' ∉ ⌊HRB_slice S⌋⇘CFG⇙"
by(fastforce simp:slice_edge_def intra_kind_def)
with ‹intra_kind (kind a')› have "transfer (slice_kind S a') s = s"
by(cases s)(auto,cases "kind a'",
auto simp:slice_kind_def Let_def intra_kind_def)
hence "transfers (slice_kinds S (a'#as')) s
= transfers (slice_kinds S as') s"
by(simp add:slice_kinds_def)
with eq IH[OF ‹∀a∈set as'. intra_kind (kind a)›
‹∀c∈set cs. sourcenode c ∈ ⌊HRB_slice S⌋⇘CFG⇙›,of s] show ?thesis by simp
qed
qed
lemma exists_sliced_intra_path_preds:
assumes "m -as→⇩ι* m'" and "slice_edges S cs as = []"
and "m' ∈ ⌊HRB_slice S⌋⇘CFG⇙" and "∀c ∈ set cs. sourcenode c ∈ ⌊HRB_slice S⌋⇘CFG⇙"
obtains as' where "m -as'→⇩ι* m'" and "preds (slice_kinds S as') (cf#cfs)"
and "slice_edges S cs as' = []"
proof(atomize_elim)
from ‹m -as→⇩ι* m'› have "m -as→* m'" and "∀a ∈ set as. intra_kind(kind a)"
by(simp_all add:intra_path_def)
from ‹slice_edges S cs as = []› ‹∀a ∈ set as. intra_kind(kind a)›
‹∀c ∈ set cs. sourcenode c ∈ ⌊HRB_slice S⌋⇘CFG⇙›
have "∀nx ∈ set(sourcenodes as). nx ∉ ⌊HRB_slice S⌋⇘CFG⇙"
by(rule slice_intra_edges_no_nodes_in_slice)
with ‹m -as→⇩ι* m'› ‹m' ∈ ⌊HRB_slice S⌋⇘CFG⇙› have "m' ∈ obs_intra m ⌊HRB_slice S⌋⇘CFG⇙"
by(fastforce intro:obs_intra_elem)
hence "obs_intra m ⌊HRB_slice S⌋⇘CFG⇙ = {m'}" by(rule obs_intra_singleton_element)
from ‹m -as→* m'› have "valid_node m" and "valid_node m'"
by(fastforce dest:path_valid_node)+
from ‹m -as→⇩ι* m'› obtain x where "distance m m' x" and "x ≤ length as"
by(erule every_path_distance)
from ‹distance m m' x› ‹obs_intra m ⌊HRB_slice S⌋⇘CFG⇙ = {m'}›
show "∃as'. m -as'→⇩ι* m' ∧ preds (slice_kinds S as') (cf#cfs) ∧
slice_edges S cs as' = []"
proof(induct x arbitrary:m rule:nat.induct)
case zero
from ‹distance m m' 0› have "m = m'"
by(fastforce elim:distance.cases simp:intra_path_def)
with ‹valid_node m'› show ?case
by(rule_tac x="[]" in exI,
auto intro:empty_path simp:slice_kinds_def intra_path_def)
next
case (Suc x)
note IH = ‹⋀m. ⟦distance m m' x; obs_intra m ⌊HRB_slice S⌋⇘CFG⇙ = {m'}⟧
⟹ ∃as'. m -as'→⇩ι* m' ∧ preds (slice_kinds S as') (cf # cfs) ∧
slice_edges S cs as' = []›
from ‹distance m m' (Suc x)› obtain a
where "valid_edge a" and "m = sourcenode a" and "intra_kind(kind a)"
and "distance (targetnode a) m' x"
and target:"targetnode a = (SOME nx. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') m' x ∧
valid_edge a' ∧ intra_kind(kind a') ∧ targetnode a' = nx)"
by(auto elim:distance_successor_distance)
have "m ∉ ⌊HRB_slice S⌋⇘CFG⇙"
proof
assume "m ∈ ⌊HRB_slice S⌋⇘CFG⇙"
from ‹valid_edge a› ‹m = sourcenode a› have "valid_node m" by simp
with ‹m ∈ ⌊HRB_slice S⌋⇘CFG⇙› have "obs_intra m ⌊HRB_slice S⌋⇘CFG⇙ = {m}"
by -(rule n_in_obs_intra)
with ‹obs_intra m ⌊HRB_slice S⌋⇘CFG⇙ = {m'}› have "m = m'" by simp
with ‹valid_node m› have "m -[]→⇩ι* m'"
by(fastforce intro:empty_path simp:intra_path_def)
with ‹distance m m' (Suc x)› show False
by(fastforce elim:distance.cases)
qed
from ‹distance (targetnode a) m' x› ‹m' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
obtain mx where "mx ∈ obs_intra (targetnode a) ⌊HRB_slice S⌋⇘CFG⇙"
by(fastforce elim:distance.cases path_ex_obs_intra)
from ‹valid_edge a› ‹intra_kind(kind a)› ‹m ∉ ⌊HRB_slice S⌋⇘CFG⇙› ‹m = sourcenode a›
have "obs_intra (targetnode a) ⌊HRB_slice S⌋⇘CFG⇙ ⊆
obs_intra (sourcenode a) ⌊HRB_slice S⌋⇘CFG⇙"
by -(rule edge_obs_intra_subset,auto)
with ‹mx ∈ obs_intra (targetnode a) ⌊HRB_slice S⌋⇘CFG⇙› ‹m = sourcenode a›
‹obs_intra m ⌊HRB_slice S⌋⇘CFG⇙ = {m'}›
have "m' ∈ obs_intra (targetnode a) ⌊HRB_slice S⌋⇘CFG⇙" by auto
hence "obs_intra (targetnode a) ⌊HRB_slice S⌋⇘CFG⇙ = {m'}"
by(rule obs_intra_singleton_element)
from IH[OF ‹distance (targetnode a) m' x› this]
obtain as where "targetnode a -as→⇩ι* m'" and "preds (slice_kinds S as) (cf#cfs)"
and "slice_edges S cs as = []" by blast
from ‹targetnode a -as→⇩ι* m'› ‹valid_edge a› ‹intra_kind(kind a)›
‹m = sourcenode a›
have "m -a#as→⇩ι* m'" by(fastforce intro:Cons_path simp:intra_path_def)
from ‹∀c ∈ set cs. sourcenode c ∈ ⌊HRB_slice S⌋⇘CFG⇙› ‹m ∉ ⌊HRB_slice S⌋⇘CFG⇙›
‹m = sourcenode a› ‹intra_kind(kind a)›
have "¬ slice_edge S cs a" by(fastforce simp:slice_edge_def intra_kind_def)
with ‹slice_edges S cs as = []› ‹intra_kind(kind a)›
have "slice_edges S cs (a#as) = []" by(fastforce simp:intra_kind_def)
from ‹intra_kind(kind a)›
show ?case
proof(cases "kind a")
case (UpdateEdge f)
with ‹m ∉ ⌊HRB_slice S⌋⇘CFG⇙› ‹m = sourcenode a› have "slice_kind S a = ⇑id"
by(fastforce intro:slice_kind_Upd)
hence "transfer (slice_kind S a) (cf#cfs) = (cf#cfs)"
and "pred (slice_kind S a) (cf#cfs)" by simp_all
with ‹preds (slice_kinds S as) (cf#cfs)›
have "preds (slice_kinds S (a#as)) (cf#cfs)"
by(simp add:slice_kinds_def)
with ‹m -a#as→⇩ι* m'› ‹slice_edges S cs (a#as) = []› show ?thesis
by blast
next
case (PredicateEdge Q)
with ‹m ∉ ⌊HRB_slice S⌋⇘CFG⇙› ‹m = sourcenode a› ‹distance m m' (Suc x)›
‹obs_intra m ⌊HRB_slice S⌋⇘CFG⇙ = {m'}› ‹distance (targetnode a) m' x›
target
have "slice_kind S a = (λs. True)⇩√"
by(fastforce intro:slice_kind_Pred_obs_nearer_SOME)
hence "transfer (slice_kind S a) (cf#cfs) = (cf#cfs)"
and "pred (slice_kind S a) (cf#cfs)" by simp_all
with ‹preds (slice_kinds S as) (cf#cfs)›
have "preds (slice_kinds S (a#as)) (cf#cfs)"
by(simp add:slice_kinds_def)
with ‹m -a#as→⇩ι* m'› ‹slice_edges S cs (a#as) = []› show ?thesis by blast
qed (auto simp:intra_kind_def)
qed
qed
lemma slp_to_intra_path_with_slice_edges:
assumes "n -as→⇘sl⇙* n'" and "slice_edges S cs as = []"
obtains as' where "n -as'→⇩ι* n'" and "slice_edges S cs as' = []"
proof(atomize_elim)
from ‹n -as→⇘sl⇙* n'› have "n -as→* n'" and "same_level_path as"
by(simp_all add:slp_def)
from ‹same_level_path as› have "same_level_path_aux [] as" and "upd_cs [] as = []"
by(simp_all add:same_level_path_def)
from ‹n -as→* n'› ‹same_level_path_aux [] as› ‹upd_cs [] as = []›
‹slice_edges S cs as = []›
show "∃as'. n -as'→⇩ι* n' ∧ slice_edges S cs as' = []"
proof(induct as arbitrary:n cs rule:length_induct)
fix as n cs
assume IH:"∀as''. length as'' < length as ⟶
(∀n''. n'' -as''→* n' ⟶ same_level_path_aux [] as'' ⟶
upd_cs [] as'' = [] ⟶ (∀cs'. slice_edges S cs' as'' = [] ⟶
(∃as'. n'' -as'→⇩ι* n' ∧ slice_edges S cs' as' = [])))"
and "n -as→* n'" and "same_level_path_aux [] as" and "upd_cs [] as = []"
and "slice_edges S cs as = []"
show "∃as'. n -as'→⇩ι* n' ∧ slice_edges S cs as' = []"
proof(cases as)
case Nil
with ‹n -as→* n'› show ?thesis by(fastforce simp:intra_path_def)
next
case (Cons a' as')
with ‹n -as→* n'› Cons have "n = sourcenode a'" and "valid_edge a'"
and "targetnode a' -as'→* n'"
by(auto intro:path_split_Cons)
show ?thesis
proof(cases "kind a'" rule:edge_kind_cases)
case Intra
with Cons ‹same_level_path_aux [] as› have "same_level_path_aux [] as'"
by(fastforce simp:intra_kind_def)
moreover
from Intra Cons ‹upd_cs [] as = []› have "upd_cs [] as' = []"
by(fastforce simp:intra_kind_def)
moreover
from ‹slice_edges S cs as = []› Cons Intra
have "slice_edges S cs as' = []" and "¬ slice_edge S cs a'"
by(cases "slice_edge S cs a'",auto simp:intra_kind_def)+
ultimately obtain as'' where "targetnode a' -as''→⇩ι* n'"
and "slice_edges S cs as'' = []"
using IH Cons ‹targetnode a' -as'→* n'›
by(erule_tac x="as'" in allE) auto
from ‹n = sourcenode a'› ‹valid_edge a'› Intra ‹targetnode a' -as''→⇩ι* n'›
have "n -a'#as''→⇩ι* n'" by(fastforce intro:Cons_path simp:intra_path_def)
moreover
from ‹slice_edges S cs as'' = []› ‹¬ slice_edge S cs a'› Intra
have "slice_edges S cs (a'#as'') = []" by(auto simp:intra_kind_def)
ultimately show ?thesis by blast
next
case (Call Q r p f)
with Cons ‹same_level_path_aux [] as›
have "same_level_path_aux [a'] as'" by simp
from Call Cons ‹upd_cs [] as = []› have "upd_cs [a'] as' = []"
by simp
hence "as' ≠ []" by fastforce
with ‹upd_cs [a'] as' = []› obtain xs ys where "as' = xs@ys" and "xs ≠ []"
and "upd_cs [a'] xs = []" and "upd_cs [] ys = []"
and "∀xs' ys'. xs = xs'@ys' ∧ ys' ≠ [] ⟶ upd_cs [a'] xs' ≠ []"
by -(erule upd_cs_empty_split,auto)
from ‹same_level_path_aux [a'] as'› ‹as' = xs@ys› ‹upd_cs [a'] xs = []›
have "same_level_path_aux [a'] xs" and "same_level_path_aux [] ys"
by(rule slpa_split)+
with ‹upd_cs [a'] xs = []› have "upd_cs ([a']@cs) xs = []@cs"
by(fastforce intro:same_level_path_upd_cs_callstack_Append)
from ‹slice_edges S cs as = []› Cons Call
have "slice_edges S (a'#cs) as' = []" and "¬ slice_edge S cs a'"
by(cases "slice_edge S cs a'",auto)+
from ‹slice_edges S (a'#cs) as' = []› ‹as' = xs@ys›
‹upd_cs ([a']@cs) xs = []@cs›
have "slice_edges S cs ys = []"
by(fastforce dest:slice_edges_Nil_split)
from ‹same_level_path_aux [a'] xs› ‹upd_cs [a'] xs = []›
‹∀xs' ys'. xs = xs'@ys' ∧ ys' ≠ [] ⟶ upd_cs [a'] xs' ≠ []›
have "last xs ∈ get_return_edges (last [a'])"
by(fastforce intro!:slpa_get_return_edges)
with ‹valid_edge a'› Call
obtain a where "valid_edge a" and "sourcenode a = sourcenode a'"
and "targetnode a = targetnode (last xs)" and "kind a = (λcf. False)⇩√"
by -(drule call_return_node_edge,auto)
from ‹targetnode a = targetnode (last xs)› ‹xs ≠ []›
have "targetnode a = targetnode (last (a'#xs))" by simp
from ‹as' = xs@ys› ‹xs ≠ []› Cons have "length ys < length as" by simp
from ‹targetnode a' -as'→* n'› ‹as' = xs@ys› ‹xs ≠ []›
have "targetnode (last (a'#xs)) -ys→* n'"
by(cases xs rule:rev_cases,auto dest:path_split)
with IH ‹length ys < length as› ‹same_level_path_aux [] ys›
‹upd_cs [] ys = []› ‹slice_edges S cs ys = []›
obtain as'' where "targetnode (last (a'#xs)) -as''→⇩ι* n'"
and "slice_edges S cs as'' = []"
apply(erule_tac x="ys" in allE) apply clarsimp
apply(erule_tac x="targetnode (last (a'#xs))" in allE)
apply clarsimp apply(erule_tac x="cs" in allE)
by clarsimp
from ‹sourcenode a = sourcenode a'› ‹n = sourcenode a'›
‹targetnode a = targetnode (last (a'#xs))› ‹valid_edge a›
‹kind a = (λcf. False)⇩√› ‹targetnode (last (a'#xs)) -as''→⇩ι* n'›
have "n -a#as''→⇩ι* n'"
by(fastforce intro:Cons_path simp:intra_path_def intra_kind_def)
moreover
from ‹kind a = (λcf. False)⇩√› ‹slice_edges S cs as'' = []›
‹¬ slice_edge S cs a'› ‹sourcenode a = sourcenode a'›
have "slice_edges S cs (a#as'') = []"
by(cases "kind a'")(auto simp:slice_edge_def)
ultimately show ?thesis by blast
next
case (Return Q p f)
with Cons ‹same_level_path_aux [] as› have False by simp
thus ?thesis by simp
qed
qed
qed
qed
subsection ‹‹S,f ⊢ (ms,s) =as⇒* (ms',s')› : the reflexive transitive
closure of ‹S,f ⊢ (ms,s) =as⇒ (ms',s')››
inductive trans_observable_moves ::
"'node SDG_node set ⇒ ('edge ⇒ ('var,'val,'ret,'pname) edge_kind) ⇒ 'node list ⇒
(('var ⇀ 'val) × 'ret) list ⇒ 'edge list ⇒ 'node list ⇒
(('var ⇀ 'val) × 'ret) list ⇒ bool"
("_,_ ⊢ '(_,_') =_⇒* '(_,_')" [51,50,0,0,50,0,0] 51)
where tom_Nil:
"length ms = length s ⟹ S,f ⊢ (ms,s) =[]⇒* (ms,s)"
| tom_Cons:
"⟦S,f ⊢ (ms,s) =as⇒ (ms',s'); S,f ⊢ (ms',s') =as'⇒* (ms'',s'')⟧
⟹ S,f ⊢ (ms,s) =(last as)#as'⇒* (ms'',s'')"
lemma tom_split_snoc:
assumes "S,f ⊢ (ms,s) =as⇒* (ms',s')" and "as ≠ []"
obtains asx asx' ms'' s'' where "as = asx@[last asx']"
and "S,f ⊢ (ms,s) =asx⇒* (ms'',s'')" and "S,f ⊢ (ms'',s'') =asx'⇒ (ms',s')"
proof(atomize_elim)
from assms show "∃asx asx' ms'' s''. as = asx @ [last asx'] ∧
S,f ⊢ (ms,s) =asx⇒* (ms'',s'') ∧ S,f ⊢ (ms'',s'') =asx'⇒ (ms',s')"
proof(induct rule:trans_observable_moves.induct)
case (tom_Cons S f ms s as ms' s' as' ms'' s'')
note IH = ‹as' ≠ [] ⟹ ∃asx asx' msx sx. as' = asx @ [last asx'] ∧
S,f ⊢ (ms',s') =asx⇒* (msx,sx) ∧ S,f ⊢ (msx,sx) =asx'⇒ (ms'',s'')›
show ?case
proof(cases "as' = []")
case True
with ‹S,f ⊢ (ms',s') =as'⇒* (ms'',s'')› have [simp]:"ms'' = ms'" "s'' = s'"
by(auto elim:trans_observable_moves.cases)
from ‹S,f ⊢ (ms,s) =as⇒ (ms',s')› have "length ms = length s"
by(rule observable_moves_equal_length)
hence "S,f ⊢ (ms,s) =[]⇒* (ms,s)" by(rule tom_Nil)
with ‹S,f ⊢ (ms,s) =as⇒ (ms',s')› True show ?thesis by fastforce
next
case False
from IH[OF this] obtain xs xs' msx sx where "as' = xs @ [last xs']"
and "S,f ⊢ (ms',s') =xs⇒* (msx,sx)"
and "S,f ⊢ (msx,sx) =xs'⇒ (ms'',s'')" by blast
from ‹S,f ⊢ (ms,s) =as⇒ (ms',s')› ‹S,f ⊢ (ms',s') =xs⇒* (msx,sx)›
have "S,f ⊢ (ms,s) =(last as)#xs⇒* (msx,sx)"
by(rule trans_observable_moves.tom_Cons)
with ‹S,f ⊢ (msx,sx) =xs'⇒ (ms'',s'')› ‹as' = xs @ [last xs']›
show ?thesis by fastforce
qed
qed simp
qed
lemma tom_preserves_stacks:
assumes "S,f ⊢ (m#ms,s) =as⇒* (m'#ms',s')" and "valid_node m"
and "valid_call_list cs m" and "∀i < length rs. rs!i ∈ get_return_edges (cs!i)"
and "valid_return_list rs m" and "length rs = length cs" and "ms = targetnodes rs"
obtains cs' rs' where "valid_node m'" and "valid_call_list cs' m'"
and "∀i < length rs'. rs'!i ∈ get_return_edges (cs'!i)"
and "valid_return_list rs' m'" and "length rs' = length cs'"
and "ms' = targetnodes rs'"
proof(atomize_elim)
from assms show "∃cs' rs'. valid_node m' ∧ valid_call_list cs' m' ∧
(∀i<length rs'. rs' ! i ∈ get_return_edges (cs' ! i)) ∧ valid_return_list rs' m' ∧
length rs' = length cs' ∧ ms' = targetnodes rs'"
proof(induct S f "m#ms" s as "m'#ms'" s' arbitrary:m ms cs rs
rule:trans_observable_moves.induct)
case (tom_Nil sx n⇩c f)
thus ?case
apply(rule_tac x="cs" in exI)
apply(rule_tac x="rs" in exI)
by clarsimp
next
case (tom_Cons S f sx as msx' sx' as' sx'')
note IH = ‹⋀m ms cs rs. ⟦msx' = m # ms; valid_node m; valid_call_list cs m;
∀i<length rs. rs ! i ∈ get_return_edges (cs ! i); valid_return_list rs m;
length rs = length cs; ms = targetnodes rs⟧
⟹ ∃cs' rs'. valid_node m' ∧ valid_call_list cs' m' ∧
(∀i<length rs'. rs' ! i ∈ get_return_edges (cs' ! i)) ∧
valid_return_list rs' m' ∧ length rs' = length cs' ∧
ms' = targetnodes rs'›
from ‹S,f ⊢ (m # ms,sx) =as⇒ (msx',sx')›
obtain m'' ms'' where "msx' = m''#ms''"
apply(cases msx') apply(auto elim!:observable_moves.cases observable_move.cases)
by(case_tac "msaa") auto
with ‹S,f ⊢ (m # ms,sx) =as⇒ (msx',sx')› ‹valid_node m›
‹valid_call_list cs m› ‹∀i<length rs. rs ! i ∈ get_return_edges (cs ! i)›
‹valid_return_list rs m› ‹length rs = length cs› ‹ms = targetnodes rs›
obtain cs'' rs'' where "valid_node m''" and "valid_call_list cs'' m''"
and "∀i < length rs''. rs''!i ∈ get_return_edges (cs''!i)"
and "valid_return_list rs'' m''" and "length rs'' = length cs''"
and "ms'' = targetnodes rs''"
by(auto elim!:observable_moves_preserves_stack)
from IH[OF ‹msx' = m''#ms''› this(1-6)]
show ?case by fastforce
qed
qed
lemma vpa_trans_observable_moves:
assumes "valid_path_aux cs as" and "m -as→* m'" and "preds (kinds as) s"
and "transfers (kinds as) s = s'" and "valid_call_list cs m"
and "∀i < length rs. rs!i ∈ get_return_edges (cs!i)"
and "valid_return_list rs m"
and "length rs = length cs" and "length s = Suc (length cs)"
obtains ms ms'' s'' ms' as' as''
where "S,kind ⊢ (m#ms,s) =slice_edges S cs as⇒* (ms'',s'')"
and "S,kind ⊢ (ms'',s'') =as'⇒⇩τ (m'#ms',s')"
and "ms = targetnodes rs" and "length ms = length cs"
and "∀i<length cs. call_of_return_node (ms!i) (sourcenode (cs!i))"
and "slice_edges S cs as = slice_edges S cs as''"
and "m -as''@as'→* m'" and "valid_path_aux cs (as''@as')"
proof(atomize_elim)
from assms show "∃ms ms'' s'' as' ms' as''.
S,kind ⊢ (m # ms,s) =slice_edges S cs as⇒* (ms'',s'') ∧
S,kind ⊢ (ms'',s'') =as'⇒⇩τ (m' # ms',s') ∧
ms = targetnodes rs ∧ length ms = length cs ∧
(∀i<length cs. call_of_return_node (ms ! i) (sourcenode (cs ! i))) ∧
slice_edges S cs as = slice_edges S cs as'' ∧
m -as'' @ as'→* m' ∧ valid_path_aux cs (as'' @ as')"
proof(induct arbitrary:m s rs rule:vpa_induct)
case (vpa_empty cs)
from ‹m -[]→* m'› have [simp]:"m' = m" by fastforce
from ‹transfers (kinds []) s = s'› ‹length s = Suc (length cs)›
have [simp]:"s' = s" by(cases cs)(auto simp:kinds_def)
from ‹valid_call_list cs m› ‹valid_return_list rs m›
‹∀i<length rs. rs ! i ∈ get_return_edges (cs ! i)› ‹length rs = length cs›
have "∀i<length cs. call_of_return_node (targetnodes rs!i) (sourcenode (cs!i))"
by(rule get_return_edges_call_of_return_nodes)
with ‹length s = Suc (length cs)› ‹m -[]→* m'› ‹length rs = length cs› show ?case
apply(rule_tac x="targetnodes rs" in exI)
apply(rule_tac x="m#targetnodes rs" in exI)
apply(rule_tac x="s" in exI)
apply(rule_tac x="[]" in exI)
apply(rule_tac x="targetnodes rs" in exI)
apply(rule_tac x="[]" in exI)
by(fastforce intro:tom_Nil silent_moves_Nil simp:targetnodes_def)
next
case (vpa_intra cs a as)
note IH = ‹⋀m s rs. ⟦m -as→* m'; preds (kinds as) s; transfers (kinds as) s = s';
valid_call_list cs m; ∀i<length rs. rs ! i ∈ get_return_edges (cs ! i);
valid_return_list rs m; length rs = length cs; length s = Suc (length cs)⟧
⟹ ∃ms ms'' s'' as' ms' as''.
S,kind ⊢ (m # ms,s) =slice_edges S cs as⇒* (ms'',s'') ∧
S,kind ⊢ (ms'',s'') =as'⇒⇩τ (m' # ms',s') ∧ ms = targetnodes rs ∧
length ms = length cs ∧
(∀i<length cs. call_of_return_node (ms ! i) (sourcenode (cs ! i))) ∧
slice_edges S cs as = slice_edges S cs as'' ∧
m -as'' @ as'→* m' ∧ valid_path_aux cs (as'' @ as')›
from ‹m -a # as→* m'› have "m = sourcenode a" and "valid_edge a"
and "targetnode a -as→* m'" by(auto elim:path_split_Cons)
from ‹preds (kinds (a # as)) s› have "pred (kind a) s"
and "preds (kinds as) (transfer (kind a) s)" by(auto simp:kinds_def)
from ‹transfers (kinds (a # as)) s = s'›
have "transfers (kinds as) (transfer (kind a) s) = s'" by(fastforce simp:kinds_def)
from ‹valid_edge a› ‹intra_kind (kind a)›
have "get_proc (sourcenode a) = get_proc (targetnode a)" by(rule get_proc_intra)
from ‹valid_call_list cs m› ‹m = sourcenode a›
‹get_proc (sourcenode a) = get_proc (targetnode a)›
have "valid_call_list cs (targetnode a)"
apply(clarsimp simp:valid_call_list_def)
apply(erule_tac x="cs'" in allE)
apply(erule_tac x="c" in allE)
by(auto split:list.split)
from ‹intra_kind (kind a)› ‹length s = Suc (length cs)›
have "length (transfer (kind a) s) = Suc (length cs)"
by(cases s)(auto simp:intra_kind_def)
from ‹valid_return_list rs m› ‹m = sourcenode a›
‹get_proc (sourcenode a) = get_proc (targetnode a)›
have "valid_return_list rs (targetnode a)"
apply(clarsimp simp:valid_return_list_def)
apply(erule_tac x="cs'" in allE) apply clarsimp
by(case_tac cs') auto
from IH[OF ‹targetnode a -as→* m'› ‹preds (kinds as) (transfer (kind a) s)›
‹transfers (kinds as) (transfer (kind a) s) = s'›
‹valid_call_list cs (targetnode a)›
‹∀i<length rs. rs ! i ∈ get_return_edges (cs ! i)› this ‹length rs = length cs›
‹length (transfer (kind a) s) = Suc (length cs)›]
obtain ms ms'' s'' as' ms' as'' where "length ms = length cs"
and "S,kind ⊢ (targetnode a # ms,transfer (kind a) s) =slice_edges S cs as⇒*
(ms'',s'')"
and paths:"S,kind ⊢ (ms'',s'') =as'⇒⇩τ (m' # ms',s')"
"ms = targetnodes rs"
"∀i<length cs. call_of_return_node (ms ! i) (sourcenode (cs ! i))"
"slice_edges S cs as = slice_edges S cs as''"
"targetnode a -as'' @ as'→* m'" "valid_path_aux cs (as'' @ as')"
by blast
from ‹∀i<length cs. call_of_return_node (ms ! i) (sourcenode (cs ! i))›
‹length ms = length cs›
have "∀mx ∈ set ms. return_node mx"
by(auto simp:call_of_return_node_def in_set_conv_nth)
show ?case
proof(cases "(∀m ∈ set ms. ∃m'. call_of_return_node m m' ∧
m' ∈ ⌊HRB_slice S⌋⇘CFG⇙) ∧ m ∈ ⌊HRB_slice S⌋⇘CFG⇙")
case True
with ‹m = sourcenode a› ‹length ms = length cs› ‹intra_kind (kind a)›
‹∀i<length cs. call_of_return_node (ms ! i) (sourcenode (cs ! i))›
have "slice_edge S cs a"
by(fastforce simp:slice_edge_def in_set_conv_nth intra_kind_def)
with ‹intra_kind (kind a)›
have "slice_edges S cs (a#as) = a#slice_edges S cs as"
by(fastforce simp:intra_kind_def)
from True ‹pred (kind a) s› ‹valid_edge a› ‹intra_kind (kind a)›
‹∀mx ∈ set ms. return_node mx› ‹length ms = length cs› ‹m = sourcenode a›
‹length s = Suc (length cs)› ‹length (transfer (kind a) s) = Suc (length cs)›
have "S,kind ⊢ (sourcenode a#ms,s) -a→ (targetnode a#ms,transfer (kind a) s)"
by(fastforce intro!:observable_move_intra)
with ‹length ms = length cs› ‹length s = Suc (length cs)›
have "S,kind ⊢ (sourcenode a#ms,s) =[]@[a]⇒
(targetnode a#ms,transfer (kind a) s)"
by(fastforce intro:observable_moves_snoc silent_moves_Nil)
with ‹S,kind ⊢ (targetnode a # ms,transfer (kind a) s) =slice_edges S cs as⇒*
(ms'',s'')›
have "S,kind ⊢ (sourcenode a#ms,s) =last [a]#slice_edges S cs as⇒* (ms'',s'')"
by(fastforce intro:tom_Cons)
with ‹slice_edges S cs (a#as) = a#slice_edges S cs as›
have "S,kind ⊢ (sourcenode a#ms,s) =slice_edges S cs (a#as)⇒* (ms'',s'')"
by simp
moreover
from ‹slice_edges S cs as = slice_edges S cs as''› ‹slice_edge S cs a›
‹intra_kind (kind a)›
have "slice_edges S cs (a#as) = slice_edges S cs (a#as'')"
by(fastforce simp:intra_kind_def)
ultimately show ?thesis
using paths ‹m = sourcenode a› ‹valid_edge a› ‹intra_kind (kind a)›
‹length ms = length cs› ‹slice_edges S cs (a#as) = a#slice_edges S cs as›
apply(rule_tac x="ms" in exI)
apply(rule_tac x="ms''" in exI)
apply(rule_tac x="s''" in exI)
apply(rule_tac x="as'" in exI)
apply(rule_tac x="ms'" in exI)
apply(rule_tac x="a#as''" in exI)
by(auto intro:Cons_path simp:intra_kind_def)
next
case False
with ‹∀mx ∈ set ms. return_node mx›
have disj:"(∃m ∈ set ms. ∃m'. call_of_return_node m m' ∧
m' ∉ ⌊HRB_slice S⌋⇘CFG⇙) ∨ m ∉ ⌊HRB_slice S⌋⇘CFG⇙"
by(fastforce dest:return_node_call_of_return_node)
with ‹m = sourcenode a› ‹length ms = length cs› ‹intra_kind (kind a)›
‹∀i<length cs. call_of_return_node (ms ! i) (sourcenode (cs ! i))›
have "¬ slice_edge S cs a"
by(fastforce simp:slice_edge_def in_set_conv_nth intra_kind_def)
with ‹intra_kind (kind a)›
have "slice_edges S cs (a#as) = slice_edges S cs as"
by(fastforce simp:intra_kind_def)
from disj ‹pred (kind a) s› ‹valid_edge a› ‹intra_kind (kind a)›
‹∀mx ∈ set ms. return_node mx› ‹length ms = length cs› ‹m = sourcenode a›
‹length s = Suc (length cs)› ‹length (transfer (kind a) s) = Suc (length cs)›
have "S,kind ⊢ (sourcenode a#ms,s) -a→⇩τ (targetnode a#ms,transfer (kind a) s)"
by(fastforce intro!:silent_move_intra)
from ‹S,kind ⊢ (targetnode a # ms,transfer (kind a) s) =slice_edges S cs as⇒*
(ms'',s'')›
show ?thesis
proof(rule trans_observable_moves.cases)
fix msx sx n⇩c' f
assume "targetnode a # ms = msx"
and "transfer (kind a) s = sx" and "slice_edges S cs as = []"
and [simp]:"ms'' = msx" "s'' = sx" and "length msx = length sx"
from ‹slice_edges S cs (a#as) = slice_edges S cs as›
‹slice_edges S cs as = []›
have "slice_edges S cs (a#as) = []" by simp
with ‹length ms = length cs› ‹length s = Suc (length cs)›
have "S,kind ⊢ (sourcenode a#ms,s) =slice_edges S cs (a#as)⇒*
(sourcenode a#ms,s)"
by(fastforce intro:tom_Nil)
moreover
from ‹S,kind ⊢ (ms'',s'') =as'⇒⇩τ (m'#ms',s')› ‹targetnode a # ms = msx›
‹transfer (kind a) s = sx› ‹ms'' = msx› ‹s'' = sx›
‹S,kind ⊢ (sourcenode a#ms,s) -a→⇩τ (targetnode a#ms,transfer (kind a) s)›
have "S,kind ⊢ (sourcenode a#ms,s) =a#as'⇒⇩τ (m'#ms',s')"
by(fastforce intro:silent_moves_Cons)
from this ‹valid_edge a› ‹∀i<length rs. rs ! i ∈ get_return_edges (cs ! i)›
‹ms = targetnodes rs› ‹valid_return_list rs m› ‹length rs = length cs›
‹length s = Suc (length cs)› ‹m = sourcenode a›
have "sourcenode a -a#as'→* m'" and "valid_path_aux cs (a#as')"
by -(rule silent_moves_vpa_path,(fastforce simp:targetnodes_def)+)+
ultimately show ?thesis using ‹m = sourcenode a› ‹length ms = length cs›
‹∀i<length cs. call_of_return_node (ms ! i) (sourcenode (cs ! i))›
‹slice_edges S cs (a#as) = []› ‹intra_kind (kind a)›
‹S,kind ⊢ (sourcenode a#ms,s) =a#as'⇒⇩τ (m'#ms',s')›
‹ms = targetnodes rs›
apply(rule_tac x="ms" in exI)
apply(rule_tac x="sourcenode a#ms" in exI)
apply(rule_tac x="s" in exI)
apply(rule_tac x="a#as'" in exI)
apply(rule_tac x="ms'" in exI)
apply(rule_tac x="[]" in exI)
by(auto simp:intra_kind_def)
next
fix S' f msx sx asx msx' sx' asx' msx'' sx''
assume [simp]:"S = S'" and "kind = f" and "targetnode a # ms = msx"
and "transfer (kind a) s = sx" and "slice_edges S cs as = last asx # asx'"
and "ms'' = msx''" and "s'' = sx''"
and "S',f ⊢ (msx,sx) =asx⇒ (msx',sx')"
and "S',f ⊢ (msx',sx') =asx'⇒* (msx'',sx'')"
from ‹kind = f› have [simp]:"f = kind" by simp
from ‹S,kind ⊢ (sourcenode a#ms,s) -a→⇩τ
(targetnode a#ms,transfer (kind a) s)› ‹S',f ⊢ (msx,sx) =asx⇒ (msx',sx')›
‹transfer (kind a) s = sx› ‹targetnode a # ms = msx›
have "S,kind ⊢ (sourcenode a#ms,s) =a#asx⇒ (msx',sx')"
by(fastforce intro:silent_move_observable_moves)
with ‹S',f ⊢ (msx',sx') =asx'⇒* (msx'',sx'')› ‹ms'' = msx''› ‹s'' = sx''›
have "S,kind ⊢ (sourcenode a#ms,s) =last (a#asx)#asx'⇒* (ms'',s'')"
by(fastforce intro:trans_observable_moves.tom_Cons)
moreover
from ‹S',f ⊢ (msx,sx) =asx⇒ (msx',sx')› have "asx ≠ []"
by(fastforce elim:observable_moves.cases)
with ‹slice_edges S cs (a#as) = slice_edges S cs as›
‹slice_edges S cs as = last asx # asx'›
have "slice_edges S cs (a#as) = last (a#asx)#asx'" by simp
moreover
from ‹¬ slice_edge S cs a› ‹slice_edges S cs as = slice_edges S cs as''›
‹intra_kind (kind a)›
have "slice_edges S cs (a # as) = slice_edges S cs (a # as'')"
by(fastforce simp:intra_kind_def)
ultimately show ?thesis using paths ‹m = sourcenode a› ‹intra_kind (kind a)›
‹length ms = length cs› ‹ms = targetnodes rs› ‹valid_edge a›
apply(rule_tac x="ms" in exI)
apply(rule_tac x="ms''" in exI)
apply(rule_tac x="s''" in exI)
apply(rule_tac x="as'" in exI)
apply(rule_tac x="ms'" in exI)
apply(rule_tac x="a#as''" in exI)
by(auto intro:Cons_path simp:intra_kind_def)
qed
qed
next
case (vpa_Call cs a as Q r p fs)
note IH = ‹⋀m s rs. ⟦m -as→* m'; preds (kinds as) s; transfers (kinds as) s = s';
valid_call_list (a # cs) m;
∀i<length rs. rs ! i ∈ get_return_edges ((a # cs) ! i);
valid_return_list rs m; length rs = length (a # cs);
length s = Suc (length (a # cs))⟧
⟹ ∃ms ms'' s'' as' ms' as''.
S,kind ⊢ (m # ms,s) =slice_edges S (a # cs) as⇒* (ms'',s'') ∧
S,kind ⊢ (ms'',s'') =as'⇒⇩τ (m' # ms',s') ∧ ms = targetnodes rs ∧
length ms = length (a # cs) ∧
(∀i<length (a # cs). call_of_return_node (ms ! i) (sourcenode ((a # cs) ! i))) ∧
slice_edges S (a # cs) as = slice_edges S (a # cs) as'' ∧
m -as'' @ as'→* m' ∧ valid_path_aux (a # cs) (as'' @ as')›
from ‹m -a # as→* m'› have "m = sourcenode a" and "valid_edge a"
and "targetnode a -as→* m'" by(auto elim:path_split_Cons)
from ‹preds (kinds (a # as)) s› have "pred (kind a) s"
and "preds (kinds as) (transfer (kind a) s)" by(auto simp:kinds_def)
from ‹transfers (kinds (a # as)) s = s'›
have "transfers (kinds as) (transfer (kind a) s) = s'" by(fastforce simp:kinds_def)
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› have "get_proc (targetnode a) = p"
by(rule get_proc_call)
with ‹valid_call_list cs m› ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› ‹m = sourcenode a›
have "valid_call_list (a # cs) (targetnode a)"
apply(clarsimp simp:valid_call_list_def)
apply(case_tac cs') apply auto
apply(erule_tac x="list" in allE)
by(case_tac list)(auto simp:sourcenodes_def)
from ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› obtain a' where "a' ∈ get_return_edges a"
by(fastforce dest:get_return_edge_call)
with ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs› obtain Q' f' where "kind a' = Q'↩⇘p⇙f'"
by(fastforce dest!:call_return_edges)
from ‹valid_edge a› ‹a' ∈ get_return_edges a› have "valid_edge a'"
by(rule get_return_edges_valid)
from ‹valid_edge a'› ‹kind a' = Q'↩⇘p⇙f'› have "get_proc (sourcenode a') = p"
by(rule get_proc_return)
from ‹∀i<length rs. rs ! i ∈ get_return_edges (cs ! i)› ‹a' ∈ get_return_edges a›
have "∀i<length (a'#rs). (a'#rs) ! i ∈ get_return_edges ((a#cs) ! i)"
by auto(case_tac i,auto)
from ‹valid_edge a› ‹a' ∈ get_return_edges a›
have "get_proc (sourcenode a) = get_proc (targetnode a')"
by(rule get_proc_get_return_edge)
with ‹valid_return_list rs m› ‹valid_edge a'› ‹kind a' = Q'↩⇘p⇙f'›
‹get_proc (sourcenode a') = p› ‹get_proc (targetnode a) = p› ‹m = sourcenode a›
have "valid_return_list (a'#rs) (targetnode a)"
apply(clarsimp simp:valid_return_list_def)
apply(case_tac cs') apply auto
apply(erule_tac x="list" in allE)
by(case_tac list)(auto simp:targetnodes_def)
from ‹length rs = length cs› have "length (a'#rs) = length (a#cs)" by simp
from ‹length s = Suc (length cs)› ‹kind a = Q:r↪⇘p⇙fs›
have "length (transfer (kind a) s) = Suc (length (a#cs))"
by(cases s) auto
from IH[OF ‹targetnode a -as→* m'› ‹preds (kinds as) (transfer (kind a) s)›
‹transfers (kinds as) (transfer (kind a) s) = s'›
‹valid_call_list (a # cs) (targetnode a)›
‹∀i<length (a'#rs). (a'#rs) ! i ∈ get_return_edges ((a#cs) ! i)›
‹valid_return_list (a'#rs) (targetnode a)› ‹length (a'#rs) = length (a#cs)›
‹length (transfer (kind a) s) = Suc (length (a#cs))›]
obtain ms ms'' s'' as' ms' as'' where "length ms = length (a#cs)"
and "S,kind ⊢ (targetnode a # ms,transfer (kind a) s)
=slice_edges S (a#cs) as⇒* (ms'',s'')"
and paths:"S,kind ⊢ (ms'',s'') =as'⇒⇩τ (m' # ms',s')"
"ms = targetnodes (a'#rs)"
"∀i<length (a#cs). call_of_return_node (ms ! i) (sourcenode ((a#cs) ! i))"
"slice_edges S (a#cs) as = slice_edges S (a#cs) as''"
"targetnode a -as'' @ as'→* m'" "valid_path_aux (a#cs) (as'' @ as')"
by blast
from ‹ms = targetnodes (a'#rs)› obtain x xs where [simp]:"ms = x#xs"
and "x = targetnode a'" and "xs = targetnodes rs"
by(cases ms)(auto simp:targetnodes_def)
from ‹∀i<length (a#cs). call_of_return_node (ms ! i) (sourcenode ((a#cs) ! i))›
‹length ms = length (a#cs)›
have "∀mx ∈ set xs. return_node mx"
apply(auto simp:in_set_conv_nth) apply(case_tac i)
apply(erule_tac x="Suc 0" in allE)
by(auto simp:call_of_return_node_def)
show ?case
proof(cases "(∀m ∈ set xs. ∃m'. call_of_return_node m m' ∧
m' ∈ ⌊HRB_slice S⌋⇘CFG⇙) ∧ sourcenode a ∈ ⌊HRB_slice S⌋⇘CFG⇙")
case True
with ‹∀i<length (a#cs). call_of_return_node (ms ! i) (sourcenode ((a#cs) ! i))›
‹length ms = length (a#cs)› ‹kind a = Q:r↪⇘p⇙fs›
have "slice_edge S cs a"
apply(auto simp:slice_edge_def in_set_conv_nth)
by(erule_tac x="Suc i" in allE) auto
with ‹kind a = Q:r↪⇘p⇙fs›
have "slice_edges S cs (a#as) = a#slice_edges S (a#cs) as" by simp
from True ‹pred (kind a) s› ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs›
‹valid_edge a'› ‹a' ∈ get_return_edges a›
‹∀mx ∈ set xs. return_node mx› ‹length ms = length (a#cs)› ‹m = sourcenode a›
‹length s = Suc (length cs)›
‹length (transfer (kind a) s) = Suc (length (a#cs))›
have "S,kind ⊢ (sourcenode a#xs,s) -a→
(targetnode a#targetnode a'#xs,transfer (kind a) s)"
by -(rule_tac a'="a'" in observable_move_call,fastforce+)
with ‹length ms = length (a#cs)› ‹length s = Suc (length cs)›
have "S,kind ⊢ (sourcenode a#xs,s) =[]@[a]⇒
(targetnode a#targetnode a'#xs,transfer (kind a) s)"
by(fastforce intro:observable_moves_snoc silent_moves_Nil)
with ‹S,kind ⊢ (targetnode a # ms,transfer (kind a) s)
=slice_edges S (a#cs) as⇒* (ms'',s'')› ‹x = targetnode a'›
have "S,kind ⊢ (sourcenode a#xs,s) =last [a]#slice_edges S (a#cs) as⇒*
(ms'',s'')"
by -(rule tom_Cons,auto)
with ‹slice_edges S cs (a#as) = a#slice_edges S (a#cs) as›
have "S,kind ⊢ (sourcenode a#xs,s) =slice_edges S cs (a#as)⇒* (ms'',s'')"
by simp
moreover
from ‹slice_edges S (a#cs) as = slice_edges S (a#cs) as''›
‹slice_edge S cs a› ‹kind a = Q:r↪⇘p⇙fs›
have "slice_edges S cs (a#as) = slice_edges S cs (a#as'')" by simp
ultimately show ?thesis
using paths ‹m = sourcenode a› ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs›
‹length ms = length (a#cs)› ‹xs = targetnodes rs›
‹slice_edges S cs (a#as) = a#slice_edges S (a#cs) as›
apply(rule_tac x="xs" in exI)
apply(rule_tac x="ms''" in exI)
apply(rule_tac x="s''" in exI)
apply(rule_tac x="as'" in exI)
apply(rule_tac x="ms'" in exI)
apply(rule_tac x="a#as''" in exI)
by(auto intro:Cons_path simp:targetnodes_def)
next
case False
with ‹∀mx ∈ set xs. return_node mx›
have disj:"(∃m ∈ set xs. ∃m'. call_of_return_node m m' ∧
m' ∉ ⌊HRB_slice S⌋⇘CFG⇙) ∨ sourcenode a ∉ ⌊HRB_slice S⌋⇘CFG⇙"
by(fastforce dest:return_node_call_of_return_node)
with ‹∀i<length (a#cs). call_of_return_node (ms ! i) (sourcenode ((a#cs) ! i))›
‹length ms = length (a#cs)› ‹kind a = Q:r↪⇘p⇙fs›
have "¬ slice_edge S cs a"
apply(auto simp:slice_edge_def in_set_conv_nth)
by(erule_tac x="Suc i" in allE) auto
with ‹kind a = Q:r↪⇘p⇙fs›
have "slice_edges S cs (a#as) = slice_edges S (a#cs) as" by simp
from disj ‹pred (kind a) s› ‹valid_edge a› ‹kind a = Q:r↪⇘p⇙fs›
‹valid_edge a'› ‹a' ∈ get_return_edges a›
‹∀mx ∈ set xs. return_node mx› ‹length ms = length (a#cs)› ‹m = sourcenode a›
‹length s = Suc (length cs)›
‹length (transfer (kind a) s) = Suc (length (a#cs))›
have "S,kind ⊢ (sourcenode a#xs,s) -a→⇩τ
(targetnode a#targetnode a'#xs,transfer (kind a) s)"
by -(rule_tac a'="a'" in silent_move_call,fastforce+)
from ‹S,kind ⊢ (targetnode a # ms,transfer (kind a) s)
=slice_edges S (a#cs) as⇒* (ms'',s'')›
show ?thesis
proof(rule trans_observable_moves.cases)
fix msx sx S' f
assume "targetnode a # ms = msx"
and "transfer (kind a) s = sx" and "slice_edges S (a#cs) as = []"
and [simp]:"ms'' = msx" "s'' = sx" and "length msx = length sx"
from ‹slice_edges S cs (a#as) = slice_edges S (a#cs) as›
‹slice_edges S (a#cs) as = []›
have "slice_edges S cs (a#as) = []" by simp
with ‹length ms = length (a#cs)› ‹length s = Suc (length cs)›
have "S,kind ⊢ (sourcenode a#xs,s) =slice_edges S cs (a#as)⇒*
(sourcenode a#xs,s)"
by(fastforce intro:tom_Nil)
moreover
from ‹S,kind ⊢ (ms'',s'') =as'⇒⇩τ (m'#ms',s')› ‹targetnode a # ms = msx›
‹transfer (kind a) s = sx› ‹ms'' = msx› ‹s'' = sx› ‹x = targetnode a'›
‹S,kind ⊢ (sourcenode a#xs,s) -a→⇩τ
(targetnode a#targetnode a'#xs,transfer (kind a) s)›
have "S,kind ⊢ (sourcenode a#xs,s) =a#as'⇒⇩τ (m'#ms',s')"
by(auto intro:silent_moves_Cons)
from this ‹valid_edge a›
‹∀i<length rs. rs ! i ∈ get_return_edges (cs ! i)›
‹xs = targetnodes rs› ‹valid_return_list rs m› ‹length rs = length cs›
‹length s = Suc (length cs)› ‹m = sourcenode a›
have "sourcenode a -a#as'→* m'" and "valid_path_aux cs (a#as')"
by -(rule silent_moves_vpa_path,(fastforce simp:targetnodes_def)+)+
ultimately show ?thesis using ‹m = sourcenode a› ‹length ms = length (a#cs)›
‹∀i<length (a#cs). call_of_return_node (ms ! i) (sourcenode ((a#cs) ! i))›
‹slice_edges S cs (a#as) = []› ‹kind a = Q:r↪⇘p⇙fs›
‹S,kind ⊢ (sourcenode a#xs,s) =a#as'⇒⇩τ (m'#ms',s')›
‹xs = targetnodes rs›
apply(rule_tac x="xs" in exI)
apply(rule_tac x="sourcenode a#xs" in exI)
apply(rule_tac x="s" in exI)
apply(rule_tac x="a#as'" in exI)
apply(rule_tac x="ms'" in exI)
apply(rule_tac x="[]" in exI)
by auto
next
fix S' f msx sx asx msx' sx' asx' msx'' sx''
assume [simp]:"S = S'" and "kind = f" and "targetnode a # ms = msx"
and "transfer (kind a) s = sx"
and "slice_edges S (a#cs) as = last asx # asx'"
and "ms'' = msx''" and "s'' = sx''"
and "S',f ⊢ (msx,sx) =asx⇒ (msx',sx')"
and "S',f ⊢ (msx',sx') =asx'⇒* (msx'',sx'')"
from ‹kind = f› have [simp]:"f = kind" by simp
from ‹S,kind ⊢ (sourcenode a#xs,s) -a→⇩τ
(targetnode a#targetnode a'#xs,transfer (kind a) s)›
‹S',f ⊢ (msx,sx) =asx⇒ (msx',sx')› ‹x = targetnode a'›
‹transfer (kind a) s = sx› ‹targetnode a # ms = msx›
have "S,kind ⊢ (sourcenode a#xs,s) =a#asx⇒ (msx',sx')"
by(auto intro:silent_move_observable_moves)
with ‹S',f ⊢ (msx',sx') =asx'⇒* (msx'',sx'')› ‹ms'' = msx''› ‹s'' = sx''›
have "S,kind ⊢ (sourcenode a#xs,s) =last (a#asx)#asx'⇒* (ms'',s'')"
by(fastforce intro:trans_observable_moves.tom_Cons)
moreover
from ‹S',f ⊢ (msx,sx) =asx⇒ (msx',sx')› have "asx ≠ []"
by(fastforce elim:observable_moves.cases)
with ‹slice_edges S cs (a#as) = slice_edges S (a#cs) as›
‹slice_edges S (a#cs) as = last asx # asx'›
have "slice_edges S cs (a#as) = last (a#asx)#asx'" by simp
moreover
from ‹¬ slice_edge S cs a› ‹kind a = Q:r↪⇘p⇙fs›
‹slice_edges S (a#cs) as = slice_edges S (a#cs) as''›
have "slice_edges S cs (a # as) = slice_edges S cs (a # as'')" by simp
ultimately show ?thesis using paths ‹m = sourcenode a› ‹kind a = Q:r↪⇘p⇙fs›
‹length ms = length (a#cs)› ‹xs = targetnodes rs› ‹valid_edge a›
apply(rule_tac x="xs" in exI)
apply(rule_tac x="ms''" in exI)
apply(rule_tac x="s''" in exI)
apply(rule_tac x="as'" in exI)
apply(rule_tac x="ms'" in exI)
apply(rule_tac x="a#as''" in exI)
by(auto intro:Cons_path simp:targetnodes_def)
qed
qed
next
case (vpa_ReturnEmpty cs a as Q p f)
from ‹preds (kinds (a # as)) s› ‹length s = Suc (length cs)› ‹kind a = Q↩⇘p⇙f›
‹cs = []›
have False by(cases s)(auto simp:kinds_def)
thus ?case by simp
next
case (vpa_ReturnCons cs a as Q p f c' cs')
note IH = ‹⋀m s rs. ⟦m -as→* m'; preds (kinds as) s; transfers (kinds as) s = s';
valid_call_list cs' m; ∀i<length rs. rs ! i ∈ get_return_edges (cs' ! i);
valid_return_list rs m; length rs = length cs'; length s = Suc (length cs')⟧
⟹ ∃ms ms'' s'' as' ms' as''.
S,kind ⊢ (m # ms,s) =slice_edges S cs' as⇒* (ms'',s'') ∧
S,kind ⊢ (ms'',s'') =as'⇒⇩τ (m' # ms',s') ∧ ms = targetnodes rs ∧
length ms = length cs' ∧
(∀i<length cs'. call_of_return_node (ms ! i) (sourcenode (cs' ! i))) ∧
slice_edges S cs' as = slice_edges S cs' as'' ∧
m -as'' @ as'→* m' ∧ valid_path_aux cs' (as'' @ as')›
from ‹m -a # as→* m'› have "m = sourcenode a" and "valid_edge a"
and "targetnode a -as→* m'" by(auto elim:path_split_Cons)
from ‹preds (kinds (a # as)) s› have "pred (kind a) s"
and "preds (kinds as) (transfer (kind a) s)" by(auto simp:kinds_def)
from ‹transfers (kinds (a # as)) s = s'›
have "transfers (kinds as) (transfer (kind a) s) = s'" by(fastforce simp:kinds_def)
from ‹valid_call_list cs m› ‹cs = c' # cs'› have "valid_edge c'"
by(fastforce simp:valid_call_list_def)
from ‹valid_edge c'› ‹a ∈ get_return_edges c'›
have "get_proc (sourcenode c') = get_proc (targetnode a)"
by(rule get_proc_get_return_edge)
from ‹valid_call_list cs m› ‹cs = c' # cs'›
‹get_proc (sourcenode c') = get_proc (targetnode a)›
have "valid_call_list cs' (targetnode a)"
apply(clarsimp simp:valid_call_list_def)
apply(hypsubst_thin)
apply(erule_tac x="c' # cs'" in allE)
by(case_tac cs')(auto simp:sourcenodes_def)
from ‹length rs = length cs› ‹cs = c' # cs'› obtain r' rs'
where [simp]:"rs = r'#rs'" and "length rs' = length cs'" by(cases rs) auto
from ‹∀i<length rs. rs ! i ∈ get_return_edges (cs ! i)› ‹cs = c' # cs'›
have "∀i<length rs'. rs' ! i ∈ get_return_edges (cs' ! i)"
and "r' ∈ get_return_edges c'" by auto
with ‹valid_edge c'› ‹a ∈ get_return_edges c'› have [simp]:"a = r'"
by -(rule get_return_edges_unique)
with ‹valid_return_list rs m›
have "valid_return_list rs' (targetnode a)"
apply(clarsimp simp:valid_return_list_def)
apply(erule_tac x="r' # cs'" in allE)
by(case_tac cs')(auto simp:targetnodes_def)
from ‹length s = Suc (length cs)› ‹cs = c' # cs'› ‹kind a = Q↩⇘p⇙f›
have "length (transfer (kind a) s) = Suc (length cs')"
by(cases s)(auto,case_tac list,auto)
from IH[OF ‹targetnode a -as→* m'› ‹preds (kinds as) (transfer (kind a) s)›
‹transfers (kinds as) (transfer (kind a) s) = s'›
‹valid_call_list cs' (targetnode a)›
‹∀i<length rs'. rs' ! i ∈ get_return_edges (cs' ! i)›
‹valid_return_list rs' (targetnode a)› ‹length rs' = length cs'› this]
obtain ms ms'' s'' as' ms' as'' where "length ms = length cs'"
and "S,kind ⊢ (targetnode a # ms,transfer (kind a) s)
=slice_edges S cs' as⇒* (ms'',s'')"
and paths:"S,kind ⊢ (ms'',s'') =as'⇒⇩τ (m' # ms',s')"
"ms = targetnodes rs'"
"∀i<length cs'. call_of_return_node (ms ! i) (sourcenode (cs' ! i))"
"slice_edges S cs' as = slice_edges S cs' as''"
"targetnode a -as'' @ as'→* m'" "valid_path_aux cs' (as'' @ as')"
by blast
from ‹∀i<length cs'. call_of_return_node (ms ! i) (sourcenode (cs' ! i))›
‹length ms = length cs'›
have "∀mx ∈ set ms. return_node mx"
by(auto simp:in_set_conv_nth call_of_return_node_def)
from ‹valid_edge a› ‹valid_edge c'› ‹a ∈ get_return_edges c'›
have "return_node (targetnode a)" by(fastforce simp:return_node_def)
with ‹valid_edge c'› ‹valid_edge a› ‹a ∈ get_return_edges c'›
have "call_of_return_node (targetnode a) (sourcenode c')"
by(simp add:call_of_return_node_def) blast
show ?case
proof(cases "(∀m ∈ set (targetnode a#ms). ∃m'. call_of_return_node m m' ∧
m' ∈ ⌊HRB_slice S⌋⇘CFG⇙)")
case True
then obtain x where "call_of_return_node (targetnode a) x"
and "x ∈ ⌊HRB_slice S⌋⇘CFG⇙" by fastforce
with ‹call_of_return_node (targetnode a) (sourcenode c')›
have "sourcenode c' ∈ ⌊HRB_slice S⌋⇘CFG⇙" by fastforce
with True ‹∀i<length cs'. call_of_return_node (ms ! i) (sourcenode (cs' ! i))›
‹length ms = length cs'› ‹cs = c' # cs'› ‹kind a = Q↩⇘p⇙f›
have "slice_edge S cs a"
apply(auto simp:slice_edge_def in_set_conv_nth)
by(erule_tac x="i" in allE) auto
with ‹kind a = Q↩⇘p⇙f› ‹cs = c' # cs'›
have "slice_edges S cs (a#as) = a#slice_edges S cs' as" by simp
from True ‹pred (kind a) s› ‹valid_edge a› ‹kind a = Q↩⇘p⇙f›
‹∀mx ∈ set ms. return_node mx› ‹length ms = length cs'›
‹length s = Suc (length cs)› ‹m = sourcenode a›
‹length (transfer (kind a) s) = Suc (length cs')›
‹return_node (targetnode a)› ‹cs = c' # cs'›
have "S,kind ⊢ (sourcenode a#targetnode a#ms,s) -a→
(targetnode a#ms,transfer (kind a) s)"
by(auto intro!:observable_move_return)
with ‹length ms = length cs'› ‹length s = Suc (length cs)› ‹cs = c' # cs'›
have "S,kind ⊢ (sourcenode a#targetnode a#ms,s) =[]@[a]⇒
(targetnode a#ms,transfer (kind a) s)"
by(fastforce intro:observable_moves_snoc silent_moves_Nil)
with ‹S,kind ⊢ (targetnode a # ms,transfer (kind a) s)
=slice_edges S cs' as⇒* (ms'',s'')›
have "S,kind ⊢ (sourcenode a#targetnode a#ms,s)
=last [a]#slice_edges S cs' as⇒* (ms'',s'')"
by -(rule tom_Cons,auto)
with ‹slice_edges S cs (a#as) = a#slice_edges S cs' as›
have "S,kind ⊢ (sourcenode a#targetnode a#ms,s) =slice_edges S cs (a#as)⇒*
(ms'',s'')" by simp
moreover
from ‹slice_edges S cs' as = slice_edges S cs' as''›
‹slice_edge S cs a› ‹kind a = Q↩⇘p⇙f› ‹cs = c' # cs'›
have "slice_edges S cs (a#as) = slice_edges S cs (a#as'')" by simp
ultimately show ?thesis
using paths ‹m = sourcenode a› ‹valid_edge a› ‹kind a = Q↩⇘p⇙f›
‹length ms = length cs'› ‹ms = targetnodes rs'› ‹cs = c' # cs'›
‹slice_edges S cs (a#as) = a#slice_edges S cs' as›
‹a ∈ get_return_edges c'›
‹call_of_return_node (targetnode a) (sourcenode c')›
apply(rule_tac x="targetnode a#ms" in exI)
apply(rule_tac x="ms''" in exI)
apply(rule_tac x="s''" in exI)
apply(rule_tac x="as'" in exI)
apply(rule_tac x="ms'" in exI)
apply(rule_tac x="a#as''" in exI)
apply(auto intro:Cons_path simp:targetnodes_def)
by(case_tac i) auto
next
case False
with ‹∀mx ∈ set ms. return_node mx› ‹return_node (targetnode a)›
have "∃m ∈ set (targetnode a # ms). ∃m'. call_of_return_node m m' ∧
m' ∉ ⌊HRB_slice S⌋⇘CFG⇙"
by(fastforce dest:return_node_call_of_return_node)
with ‹∀i<length cs'. call_of_return_node (ms ! i) (sourcenode (cs' ! i))›
‹length ms = length cs'› ‹cs = c' # cs'› ‹kind a = Q↩⇘p⇙f›
‹call_of_return_node (targetnode a) (sourcenode c')›
have "¬ slice_edge S cs a"
apply(auto simp:slice_edge_def in_set_conv_nth)
by(erule_tac x="i" in allE) auto
with ‹kind a = Q↩⇘p⇙f› ‹cs = c' # cs'›
have "slice_edges S cs (a#as) = slice_edges S cs' as" by simp
from ‹pred (kind a) s› ‹valid_edge a› ‹kind a = Q↩⇘p⇙f›
‹∀mx ∈ set ms. return_node mx› ‹length ms = length cs'›
‹length s = Suc (length cs)› ‹m = sourcenode a›
‹length (transfer (kind a) s) = Suc (length cs')›
‹return_node (targetnode a)› ‹cs = c' # cs'›
‹∃m ∈ set (targetnode a # ms). ∃m'. call_of_return_node m m' ∧
m' ∉ ⌊HRB_slice S⌋⇘CFG⇙›
have "S,kind ⊢ (sourcenode a#targetnode a#ms,s) -a→⇩τ
(targetnode a#ms,transfer (kind a) s)"
by(auto intro!:silent_move_return)
from ‹S,kind ⊢ (targetnode a # ms,transfer (kind a) s)
=slice_edges S cs' as⇒* (ms'',s'')›
show ?thesis
proof(rule trans_observable_moves.cases)
fix msx sx S' f'
assume "targetnode a # ms = msx"
and "transfer (kind a) s = sx" and "slice_edges S cs' as = []"
and [simp]:"ms'' = msx" "s'' = sx" and "length msx = length sx"
from ‹slice_edges S cs (a#as) = slice_edges S cs' as›
‹slice_edges S cs' as = []›
have "slice_edges S cs (a#as) = []" by simp
with ‹length ms = length cs'› ‹length s = Suc (length cs)› ‹cs = c' # cs'›
have "S,kind ⊢ (sourcenode a#targetnode a#ms,s) =slice_edges S cs (a#as)⇒*
(sourcenode a#targetnode a#ms,s)"
by(fastforce intro:tom_Nil)
moreover
from ‹S,kind ⊢ (ms'',s'') =as'⇒⇩τ (m'#ms',s')› ‹targetnode a # ms = msx›
‹transfer (kind a) s = sx› ‹ms'' = msx› ‹s'' = sx›
‹S,kind ⊢ (sourcenode a#targetnode a#ms,s) -a→⇩τ
(targetnode a#ms,transfer (kind a) s)›
have "S,kind ⊢ (sourcenode a#targetnode a#ms,s) =a#as'⇒⇩τ (m'#ms',s')"
by(auto intro:silent_moves_Cons)
from this ‹valid_edge a›
‹∀i<length rs. rs ! i ∈ get_return_edges (cs ! i)›
‹valid_return_list rs m› ‹length rs = length cs›
‹length s = Suc (length cs)› ‹m = sourcenode a›
‹ms = targetnodes rs'› ‹rs = r'#rs'› ‹cs = c' # cs'›
have "sourcenode a -a#as'→* m'" and "valid_path_aux cs (a#as')"
by -(rule silent_moves_vpa_path,(fastforce simp:targetnodes_def)+)+
ultimately show ?thesis using ‹m = sourcenode a› ‹length ms = length cs'›
‹∀i<length cs'. call_of_return_node (ms ! i) (sourcenode (cs' ! i))›
‹slice_edges S cs (a#as) = []› ‹kind a = Q↩⇘p⇙f›
‹S,kind ⊢ (sourcenode a#targetnode a#ms,s) =a#as'⇒⇩τ (m'#ms',s')›
‹ms = targetnodes rs'› ‹rs = r'#rs'› ‹cs = c' # cs'›
‹call_of_return_node (targetnode a) (sourcenode c')›
apply(rule_tac x="targetnode a#ms" in exI)
apply(rule_tac x="sourcenode a#targetnode a#ms" in exI)
apply(rule_tac x="s" in exI)
apply(rule_tac x="a#as'" in exI)
apply(rule_tac x="ms'" in exI)
apply(rule_tac x="[]" in exI)
apply(auto simp:targetnodes_def)
by(case_tac i) auto
next
fix S' f' msx sx asx msx' sx' asx' msx'' sx''
assume [simp]:"S = S'" and "kind = f'" and "targetnode a # ms = msx"
and "transfer (kind a) s = sx"
and "slice_edges S cs' as = last asx # asx'"
and "ms'' = msx''" and "s'' = sx''"
and "S',f' ⊢ (msx,sx) =asx⇒ (msx',sx')"
and "S',f' ⊢ (msx',sx') =asx'⇒* (msx'',sx'')"
from ‹kind = f'› have [simp]:"f' = kind" by simp
from ‹S,kind ⊢ (sourcenode a#targetnode a#ms,s) -a→⇩τ
(targetnode a#ms,transfer (kind a) s)›
‹S',f' ⊢ (msx,sx) =asx⇒ (msx',sx')›
‹transfer (kind a) s = sx› ‹targetnode a # ms = msx›
have "S,kind ⊢ (sourcenode a#targetnode a#ms,s) =a#asx⇒ (msx',sx')"
by(auto intro:silent_move_observable_moves)
with ‹S',f' ⊢ (msx',sx') =asx'⇒* (msx'',sx'')› ‹ms'' = msx''› ‹s'' = sx''›
have "S,kind ⊢ (sourcenode a#targetnode a#ms,s) =last (a#asx)#asx'⇒*
(ms'',s'')"
by(fastforce intro:trans_observable_moves.tom_Cons)
moreover
from ‹S',f' ⊢ (msx,sx) =asx⇒ (msx',sx')› have "asx ≠ []"
by(fastforce elim:observable_moves.cases)
with ‹slice_edges S cs (a#as) = slice_edges S cs' as›
‹slice_edges S cs' as = last asx # asx'›
have "slice_edges S cs (a#as) = last (a#asx)#asx'" by simp
moreover
from ‹¬ slice_edge S cs a› ‹kind a = Q↩⇘p⇙f›
‹slice_edges S cs' as = slice_edges S cs' as''› ‹cs = c' # cs'›
have "slice_edges S cs (a # as) = slice_edges S cs (a # as'')" by simp
ultimately show ?thesis using paths ‹m = sourcenode a› ‹kind a = Q↩⇘p⇙f›
‹length ms = length cs'› ‹ms = targetnodes rs'› ‹valid_edge a›
‹rs = r'#rs'› ‹cs = c' # cs'› ‹r' ∈ get_return_edges c'›
‹call_of_return_node (targetnode a) (sourcenode c')›
apply(rule_tac x="targetnode a#ms" in exI)
apply(rule_tac x="ms''" in exI)
apply(rule_tac x="s''" in exI)
apply(rule_tac x="as'" in exI)
apply(rule_tac x="ms'" in exI)
apply(rule_tac x="a#as''" in exI)
apply(auto intro:Cons_path simp:targetnodes_def)
by(case_tac i) auto
qed
qed
qed
qed
lemma valid_path_trans_observable_moves:
assumes "m -as→⇩√* m'" and "preds (kinds as) [cf]"
and "transfers (kinds as) [cf] = s'"
obtains ms'' s'' ms' as' as''
where "S,kind ⊢ ([m],[cf]) =slice_edges S [] as⇒* (ms'',s'')"
and "S,kind ⊢ (ms'',s'') =as'⇒⇩τ (m'#ms',s')"
and "slice_edges S [] as = slice_edges S [] as''"
and "m -as''@as'→⇩√* m'"
proof(atomize_elim)
from ‹m -as→⇩√* m'› have "valid_path_aux [] as" and "m -as→* m'"
by(simp_all add:vp_def valid_path_def)
from this ‹preds (kinds as) [cf]› ‹transfers (kinds as) [cf] = s'›
show "∃ms'' s'' as' ms' as''.
S,kind ⊢ ([m],[cf]) =slice_edges S [] as⇒* (ms'',s'') ∧
S,kind ⊢ (ms'',s'') =as'⇒⇩τ (m' # ms',s') ∧
slice_edges S [] as = slice_edges S [] as'' ∧ m -as'' @ as'→⇩√* m'"
by -(erule vpa_trans_observable_moves[of _ _ _ _ _ _ "[]" S],
auto simp:valid_call_list_def valid_return_list_def vp_def valid_path_def)
qed
lemma WS_weak_sim_trans:
assumes "((ms⇩1,s⇩1),(ms⇩2,s⇩2)) ∈ WS S"
and "S,kind ⊢ (ms⇩1,s⇩1) =as⇒* (ms⇩1',s⇩1')" and "as ≠ []"
shows "((ms⇩1',s⇩1'),(ms⇩1',transfers (slice_kinds S as) s⇩2)) ∈ WS S ∧
S,slice_kind S ⊢ (ms⇩2,s⇩2) =as⇒* (ms⇩1',transfers (slice_kinds S as) s⇩2)"
proof -
obtain f where "f = kind" by simp
with ‹S,kind ⊢ (ms⇩1,s⇩1) =as⇒* (ms⇩1',s⇩1')›
have "S,f ⊢ (ms⇩1,s⇩1) =as⇒* (ms⇩1',s⇩1')" by simp
from ‹S,f ⊢ (ms⇩1,s⇩1) =as⇒* (ms⇩1',s⇩1')› ‹((ms⇩1,s⇩1),(ms⇩2,s⇩2)) ∈ WS S›
‹as ≠ []› ‹f = kind›
show ?thesis
proof(induct arbitrary:ms⇩2 s⇩2 rule:trans_observable_moves.induct)
case tom_Nil thus ?case by simp
next
case (tom_Cons S f ms s as ms' s' as' ms'' s'')
note IH = ‹⋀ms⇩2 s⇩2. ⟦((ms',s'),(ms⇩2,s⇩2)) ∈ WS S; as' ≠ []; f = kind⟧
⟹ ((ms'',s''),(ms'',transfers (slice_kinds S as') s⇩2)) ∈ WS S ∧
S,slice_kind S ⊢ (ms⇩2,s⇩2) =as'⇒* (ms'',transfers (slice_kinds S as') s⇩2)›
from ‹S,f ⊢ (ms,s) =as⇒ (ms',s')› have "s' ≠ []"
by(fastforce elim:observable_moves.cases observable_move.cases)
from ‹S,f ⊢ (ms,s) =as⇒ (ms',s')›
obtain asx ax msx sx where "S,f ⊢ (ms,s) =asx⇒⇩τ (msx,sx)"
and "S,f ⊢ (msx,sx) -ax→ (ms',s')" and "as = asx@[ax]"
by(fastforce elim:observable_moves.cases)
from ‹S,f ⊢ (ms,s) =asx⇒⇩τ (msx,sx)› ‹((ms,s),(ms⇩2,s⇩2)) ∈ WS S› ‹f = kind›
have "((msx,sx),(ms⇩2,s⇩2)) ∈ WS S" by(fastforce intro:WS_silent_moves)
from ‹((msx,sx),(ms⇩2,s⇩2)) ∈ WS S› ‹S,f ⊢ (msx,sx) -ax→ (ms',s')› ‹s' ≠ []›
‹f = kind›
obtain asx' where "((ms',s'),(ms',transfer (slice_kind S ax) s⇩2)) ∈ WS S"
and "S,slice_kind S ⊢ (ms⇩2,s⇩2) =asx'@[ax]⇒
(ms',transfer (slice_kind S ax) s⇩2)"
by(fastforce elim:WS_observable_move)
show ?case
proof(cases "as' = []")
case True
with ‹S,f ⊢ (ms',s') =as'⇒* (ms'',s'')› have "ms' = ms'' ∧ s' = s''"
by(fastforce elim:trans_observable_moves.cases dest:observable_move_notempty)
from ‹((ms',s'),(ms',transfer (slice_kind S ax) s⇩2)) ∈ WS S›
have "length ms' = length (transfer (slice_kind S ax) s⇩2)"
by(fastforce elim:WS.cases)
with ‹S,slice_kind S ⊢ (ms⇩2,s⇩2) =asx'@[ax]⇒
(ms',transfer (slice_kind S ax) s⇩2)›
have "S,slice_kind S ⊢ (ms⇩2,s⇩2) =(last (asx'@[ax]))#[]⇒*
(ms',transfer (slice_kind S ax) s⇩2)"
by(fastforce intro:trans_observable_moves.intros)
with ‹((ms',s'),(ms',transfer (slice_kind S ax) s⇩2)) ∈ WS S› ‹as = asx@[ax]›
‹ms' = ms'' ∧ s' = s''› True
show ?thesis by(fastforce simp:slice_kinds_def)
next
case False
from IH[OF ‹((ms',s'),(ms',transfer (slice_kind S ax) s⇩2)) ∈ WS S› this
‹f = kind›]
have "((ms'',s''),(ms'',transfers (slice_kinds S as')
(transfer (slice_kind S ax) s⇩2))) ∈ WS S"
and "S,slice_kind S ⊢ (ms',transfer (slice_kind S ax) s⇩2) =as'⇒*
(ms'',transfers (slice_kinds S as') (transfer (slice_kind S ax) s⇩2))"
by simp_all
with ‹S,slice_kind S ⊢ (ms⇩2,s⇩2) =asx'@[ax]⇒
(ms',transfer (slice_kind S ax) s⇩2)›
have "S,slice_kind S ⊢ (ms⇩2,s⇩2) =(last (asx'@[ax]))#as'⇒*
(ms'',transfers (slice_kinds S as') (transfer (slice_kind S ax) s⇩2))"
by(fastforce intro:trans_observable_moves.tom_Cons)
with ‹((ms'',s''),(ms'',transfers (slice_kinds S as')
(transfer (slice_kind S ax) s⇩2))) ∈ WS S› False ‹as = asx@[ax]›
show ?thesis by(fastforce simp:slice_kinds_def)
qed
qed
qed
lemma stacks_rewrite:
assumes "valid_call_list cs m" and "valid_return_list rs m"
and "∀i < length rs. rs!i ∈ get_return_edges (cs!i)"
and "length rs = length cs" and "ms = targetnodes rs"
shows "∀i<length cs. call_of_return_node (ms!i) (sourcenode (cs!i))"
proof
fix i show "i < length cs ⟶
call_of_return_node (ms ! i) (sourcenode (cs ! i))"
proof
assume "i < length cs"
with ‹∀i < length rs. rs!i ∈ get_return_edges (cs!i)› ‹length rs = length cs›
have "rs!i ∈ get_return_edges (cs!i)" by fastforce
from ‹valid_return_list rs m› have "∀r ∈ set rs. valid_edge r"
by(rule valid_return_list_valid_edges)
with ‹i < length cs› ‹length rs = length cs›
have "valid_edge (rs!i)" by(simp add:all_set_conv_all_nth)
from ‹valid_call_list cs m› have "∀c ∈ set cs. valid_edge c"
by(rule valid_call_list_valid_edges)
with ‹i < length cs› have "valid_edge (cs!i)" by(simp add:all_set_conv_all_nth)
with ‹valid_edge (rs!i)› ‹rs!i ∈ get_return_edges (cs!i)› ‹ms = targetnodes rs›
‹i < length cs› ‹length rs = length cs›
show "call_of_return_node (ms ! i) (sourcenode (cs ! i))"
by(fastforce simp:call_of_return_node_def return_node_def targetnodes_def)
qed
qed
lemma slice_tom_preds_vp:
assumes "S,slice_kind S ⊢ (m#ms,s) =as⇒* (m'#ms',s')" and "valid_node m"
and "valid_call_list cs m" and "∀i < length rs. rs!i ∈ get_return_edges (cs!i)"
and "valid_return_list rs m" and "length rs = length cs" and "ms = targetnodes rs"
and "∀mx ∈ set ms. ∃mx'. call_of_return_node mx mx' ∧ mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙"
obtains as' cs' rs' where "preds (slice_kinds S as') s"
and "slice_edges S cs as' = as" and "m -as'→* m'" and "valid_path_aux cs as'"
and "upd_cs cs as' = cs'" and "valid_node m'" and "valid_call_list cs' m'"
and "∀i < length rs'. rs'!i ∈ get_return_edges (cs'!i)"
and "valid_return_list rs' m'" and "length rs' = length cs'"
and "ms' = targetnodes rs'" and "transfers (slice_kinds S as') s ≠ []"
and "transfers (slice_kinds S (slice_edges S cs as')) s =
transfers (slice_kinds S as') s"
proof(atomize_elim)
from assms show "∃as' cs' rs'. preds (slice_kinds S as') s ∧
slice_edges S cs as' = as ∧ m -as'→* m' ∧ valid_path_aux cs as' ∧
upd_cs cs as' = cs' ∧ valid_node m' ∧ valid_call_list cs' m' ∧
(∀i<length rs'. rs' ! i ∈ get_return_edges (cs' ! i)) ∧ valid_return_list rs' m' ∧
length rs' = length cs' ∧ ms' = targetnodes rs' ∧
transfers (slice_kinds S as') s ≠ [] ∧
transfers (slice_kinds S (slice_edges S cs as')) s =
transfers (slice_kinds S as') s"
proof(induct S "slice_kind S" "m#ms" s as "m'#ms'" s'
arbitrary:m ms cs rs rule:trans_observable_moves.induct)
case (tom_Nil s n⇩c)
from ‹length (m' # ms') = length s› have "s ≠ []" by(cases s) auto
have "preds (slice_kinds S []) s" by(fastforce simp:slice_kinds_def)
moreover
have "slice_edges S cs [] = []" by simp
moreover
from ‹valid_node m'› have "m' -[]→* m'" by(fastforce intro:empty_path)
moreover
have "valid_path_aux cs []" by simp
moreover
have "upd_cs cs [] = cs" by simp
ultimately show ?case using ‹valid_call_list cs m'› ‹valid_return_list rs m'›
‹∀i<length rs. rs ! i ∈ get_return_edges (cs ! i)› ‹length rs = length cs›
‹ms' = targetnodes rs› ‹s ≠ []› ‹valid_node m'›
apply(rule_tac x="[]" in exI)
apply(rule_tac x="cs" in exI)
apply(rule_tac x="rs" in exI)
by(clarsimp simp:slice_kinds_def)
next
case (tom_Cons S s as msx' s' as' sx'')
note IH = ‹⋀m ms cs rs. ⟦msx' = m # ms; valid_node m; valid_call_list cs m;
∀i<length rs. rs ! i ∈ get_return_edges (cs ! i); valid_return_list rs m;
length rs = length cs; ms = targetnodes rs;
∀mx∈set ms. ∃mx'. call_of_return_node mx mx' ∧ mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙⟧
⟹ ∃as'' cs' rs'. preds (slice_kinds S as'') s' ∧
slice_edges S cs as'' = as' ∧ m -as''→* m' ∧ valid_path_aux cs as'' ∧
upd_cs cs as'' = cs' ∧ valid_node m' ∧ valid_call_list cs' m' ∧
(∀i<length rs'. rs' ! i ∈ get_return_edges (cs' ! i)) ∧
valid_return_list rs' m' ∧ length rs' = length cs' ∧ ms' = targetnodes rs' ∧
transfers (slice_kinds S as'') s' ≠ [] ∧
transfers (slice_kinds S (slice_edges S cs as'')) s' =
transfers (slice_kinds S as'') s'›
note callstack = ‹∀mx∈set ms.
∃mx'. call_of_return_node mx mx' ∧ mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙›
from ‹S,slice_kind S ⊢ (m # ms,s) =as⇒ (msx',s')›
obtain asx ax xs s'' where "as = asx@[ax]"
and "S,slice_kind S ⊢ (m#ms,s) =asx⇒⇩τ (xs,s'')"
and "S,slice_kind S ⊢ (xs,s'') -ax→ (msx',s')"
by(fastforce elim:observable_moves.cases)
from ‹S,slice_kind S ⊢ (xs,s'') -ax→ (msx',s')›
obtain xs' ms'' where [simp]:"xs = sourcenode ax#xs'" "msx' = targetnode ax#ms''"
by (cases xs) (auto elim!:observable_move.cases, cases msx', auto)
from ‹S,slice_kind S ⊢ (m # ms,s) =as⇒ (msx',s')› tom_Cons
obtain cs'' rs'' where results:"valid_node (targetnode ax)"
"valid_call_list cs'' (targetnode ax)"
"∀i < length rs''. rs''!i ∈ get_return_edges (cs''!i)"
"valid_return_list rs'' (targetnode ax)" "length rs'' = length cs''"
"ms'' = targetnodes rs''" and "upd_cs cs as = cs''"
by(auto elim!:observable_moves_preserves_stack)
from ‹S,slice_kind S ⊢ (m#ms,s) =asx⇒⇩τ (xs,s'')› callstack
have "∀a ∈ set asx. intra_kind (kind a)"
by simp(rule silent_moves_slice_intra_path)
with ‹S,slice_kind S ⊢ (m#ms,s) =asx⇒⇩τ (xs,s'')›
have [simp]:"xs' = ms" by(fastforce dest:silent_moves_intra_path)
from ‹S,slice_kind S ⊢ (xs,s'') -ax→ (msx',s')›
have "∀mx ∈ set ms''. ∃mx'. call_of_return_node mx mx' ∧ mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙"
by(fastforce dest:observable_set_stack_in_slice)
from IH[OF ‹msx' = targetnode ax#ms''› results this]
obtain asx' cs' rs' where "preds (slice_kinds S asx') s'"
and "slice_edges S cs'' asx' = as'" and "targetnode ax -asx'→* m'"
and "valid_path_aux cs'' asx'" and "upd_cs cs'' asx' = cs'"
and "valid_node m'" and "valid_call_list cs' m'"
and "∀i<length rs'. rs' ! i ∈ get_return_edges (cs' ! i)"
and "valid_return_list rs' m'" and "length rs' = length cs'"
and "ms' = targetnodes rs'" and "transfers (slice_kinds S asx') s' ≠ []"
and trans_eq:"transfers (slice_kinds S (slice_edges S cs'' asx')) s' =
transfers (slice_kinds S asx') s'"
by blast
from ‹S,slice_kind S ⊢ (m#ms,s) =asx⇒⇩τ (xs,s'')›
have "preds (slice_kinds S asx) s" and "transfers (slice_kinds S asx) s = s''"
by(auto intro:silent_moves_preds_transfers simp:slice_kinds_def)
from ‹S,slice_kind S ⊢ (xs,s'') -ax→ (msx',s')›
have "pred (slice_kind S ax) s''" and "transfer (slice_kind S ax) s'' = s'"
by(auto elim:observable_move.cases)
with ‹preds (slice_kinds S asx) s› ‹as = asx@[ax]›
‹transfers (slice_kinds S asx) s = s''›
have "preds (slice_kinds S as) s" by(simp add:preds_split slice_kinds_def)
from ‹transfers (slice_kinds S asx) s = s''›
‹transfer (slice_kind S ax) s'' = s'› ‹as = asx@[ax]›
have "transfers (slice_kinds S as) s = s'"
by(simp add:transfers_split slice_kinds_def)
with ‹preds (slice_kinds S asx') s'› ‹preds (slice_kinds S as) s›
have "preds (slice_kinds S (as@asx')) s" by(simp add:preds_split slice_kinds_def)
moreover
from ‹valid_call_list cs m› ‹valid_return_list rs m›
‹∀i<length rs. rs ! i ∈ get_return_edges (cs ! i)› ‹length rs = length cs›
‹ms = targetnodes rs›
have "∀i<length cs. call_of_return_node (ms!i) (sourcenode (cs!i))"
by(rule stacks_rewrite)
with ‹S,slice_kind S ⊢ (m # ms,s) =as⇒ (msx',s')› ‹ms = targetnodes rs›
‹length rs = length cs›
have "slice_edges S cs as = [last as]"
by(fastforce elim:observable_moves_singular_slice_edge)
with ‹slice_edges S cs'' asx' = as'› ‹upd_cs cs as = cs''›
have "slice_edges S cs (as@asx') = [last as]@as'"
by(fastforce intro:slice_edges_Append)
moreover
from ‹S,slice_kind S ⊢ (m#ms,s) =asx⇒⇩τ (xs,s'')› ‹valid_node m›
‹valid_call_list cs m› ‹∀i<length rs. rs ! i ∈ get_return_edges (cs ! i)›
‹valid_return_list rs m› ‹length rs = length cs› ‹ms = targetnodes rs›
have "m -asx→* sourcenode ax" by(fastforce intro:silent_moves_vpa_path)
from ‹S,slice_kind S ⊢ (xs,s'') -ax→ (msx',s')› have "valid_edge ax"
by(fastforce elim:observable_move.cases)
hence "sourcenode ax -[ax]→* targetnode ax" by(rule path_edge)
with ‹m -asx→* sourcenode ax› ‹as = asx@[ax]›
have "m -as→* targetnode ax" by(fastforce intro:path_Append)
with ‹targetnode ax -asx'→* m'› have "m -as@asx'→* m'"
by -(rule path_Append)
moreover
from ‹∀a ∈ set asx. intra_kind (kind a)› have "valid_path_aux cs asx"
by(rule valid_path_aux_intra_path)
from ‹∀a ∈ set asx. intra_kind (kind a)› have "upd_cs cs asx = cs"
by(rule upd_cs_intra_path)
from ‹m -asx→* sourcenode ax› ‹∀a ∈ set asx. intra_kind (kind a)›
have "get_proc m = get_proc (sourcenode ax)"
by(fastforce intro:intra_path_get_procs simp:intra_path_def)
with ‹valid_return_list rs m› have "valid_return_list rs (sourcenode ax)"
apply(clarsimp simp:valid_return_list_def)
apply(erule_tac x="cs'" in allE) apply clarsimp
by(case_tac cs') auto
with ‹S,slice_kind S ⊢ (xs,s'') -ax→ (msx',s')› ‹valid_edge ax›
‹∀i<length rs. rs ! i ∈ get_return_edges (cs ! i)› ‹ms = targetnodes rs›
‹length rs = length cs›
have "valid_path_aux cs [ax]"
by(auto intro!:observable_move_vpa_path simp del:valid_path_aux.simps)
with ‹valid_path_aux cs asx› ‹upd_cs cs asx = cs› ‹as = asx@[ax]›
have "valid_path_aux cs as" by(fastforce intro:valid_path_aux_Append)
with ‹upd_cs cs as = cs''› ‹valid_path_aux cs'' asx'›
have "valid_path_aux cs (as@asx')" by(fastforce intro:valid_path_aux_Append)
moreover
from ‹upd_cs cs as = cs''› ‹upd_cs cs'' asx' = cs'›
have "upd_cs cs (as@asx') = cs'" by(rule upd_cs_Append)
moreover
from ‹transfers (slice_kinds S as) s = s'›
‹transfers (slice_kinds S asx') s' ≠ []›
have "transfers (slice_kinds S (as@asx')) s ≠ []"
by(simp add:slice_kinds_def transfers_split)
moreover
from ‹S,slice_kind S ⊢ (m # ms,s) =as⇒ (msx',s')›
have "transfers (map (slice_kind S) as) s = s'"
by simp(rule observable_moves_preds_transfers)
from ‹S,slice_kind S ⊢ (m # ms,s) =as⇒ (msx',s')› ‹ms = targetnodes rs›
‹length rs = length cs› ‹∀i<length rs. rs ! i ∈ get_return_edges (cs ! i)›
‹valid_call_list cs m› ‹valid_return_list rs m›
have "slice_edges S cs as = [last as]"
by(fastforce intro!:observable_moves_singular_slice_edge
[OF _ _ _ stacks_rewrite])
from ‹S,slice_kind S ⊢ (m#ms,s) =asx⇒⇩τ (xs,s'')› callstack
have "s = s''" by(fastforce intro:silent_moves_slice_keeps_state)
with ‹S,slice_kind S ⊢ (xs,s'') -ax→ (msx',s')›
have "transfer (slice_kind S ax) s = s'" by(fastforce elim:observable_move.cases)
with ‹slice_edges S cs as = [last as]› ‹as = asx@[ax]›
have "s' = transfers (slice_kinds S (slice_edges S cs as)) s"
by(simp add:slice_kinds_def)
from ‹upd_cs cs as = cs''›
have "slice_edges S cs (as @ asx') =
(slice_edges S cs as)@(slice_edges S cs'' asx')"
by(fastforce intro:slice_edges_Append)
hence trans_eq':"transfers (slice_kinds S (slice_edges S cs (as @ asx'))) s =
transfers (slice_kinds S (slice_edges S cs'' asx'))
(transfers (slice_kinds S (slice_edges S cs as)) s)"
by(simp add:slice_kinds_def transfers_split)
from ‹s' = transfers (slice_kinds S (slice_edges S cs as)) s›
‹transfers (map (slice_kind S) as) s = s'›
have "transfers (map (slice_kind S) (slice_edges S cs as)) s =
transfers (map (slice_kind S) as) s"
by(simp add:slice_kinds_def)
with trans_eq trans_eq'
‹s' = transfers (slice_kinds S (slice_edges S cs as)) s›
have "transfers (slice_kinds S (slice_edges S cs (as @ asx'))) s =
transfers (slice_kinds S (as @ asx')) s"
by(simp add:slice_kinds_def transfers_split)
ultimately show ?case
using ‹valid_node m'› ‹valid_call_list cs' m'›
‹∀i<length rs'. rs' ! i ∈ get_return_edges (cs' ! i)›
‹valid_return_list rs' m'› ‹length rs' = length cs'› ‹ms' = targetnodes rs'›
apply(rule_tac x="as@asx'" in exI)
apply(rule_tac x="cs'" in exI)
apply(rule_tac x="rs'" in exI)
by clarsimp
qed
qed
subsection ‹The fundamental property of static interprocedural slicing›
theorem fundamental_property_of_static_slicing:
assumes "m -as→⇩√* m'" and "preds (kinds as) [cf]" and "CFG_node m' ∈ S"
obtains as' where "preds (slice_kinds S as') [cf]"
and "∀V ∈ Use m'. state_val (transfers (slice_kinds S as') [cf]) V =
state_val (transfers (kinds as) [cf]) V"
and "slice_edges S [] as = slice_edges S [] as'"
and "transfers (kinds as) [cf] ≠ []" and "m -as'→⇩√* m'"
proof(atomize_elim)
from ‹m -as→⇩√* m'› ‹preds (kinds as) [cf]› obtain ms'' s'' ms' as' as''
where "S,kind ⊢ ([m],[cf]) =slice_edges S [] as⇒*
(ms'',s'')"
and "S,kind ⊢ (ms'',s'') =as'⇒⇩τ (m'#ms',transfers (kinds as) [cf])"
and "slice_edges S [] as = slice_edges S [] as''"
and "m -as''@as'→⇩√* m'"
by(auto elim:valid_path_trans_observable_moves[of _ _ _ _ _ "S"])
from ‹m -as→⇩√* m'› have "valid_node m" and "valid_node m'"
by(auto intro:path_valid_node simp:vp_def)
with ‹CFG_node m' ∈ S› have "CFG_node m' ∈ HRB_slice S"
by -(rule HRB_slice_refl)
from ‹valid_node m› ‹CFG_node m' ∈ S› have "(([m],[cf]),([m],[cf])) ∈ WS S"
by(fastforce intro:WSI)
{ fix V assume "V ∈ Use m'"
with ‹valid_node m'› have "V ∈ Use⇘SDG⇙ (CFG_node m')"
by(fastforce intro:CFG_Use_SDG_Use)
moreover
from ‹valid_node m'›
have "parent_node (CFG_node m') -[]→⇩ι* parent_node (CFG_node m')"
by(fastforce intro:empty_path simp:intra_path_def)
ultimately have "V ∈ rv S (CFG_node m')"
using ‹CFG_node m' ∈ HRB_slice S› ‹CFG_node m' ∈ S›
by(fastforce intro:rvI simp:sourcenodes_def) }
hence "∀V ∈ Use m'. V ∈ rv S (CFG_node m')" by simp
show "∃as'. preds (slice_kinds S as') [cf] ∧
(∀V∈Use m'. state_val (transfers (slice_kinds S as') [cf]) V =
state_val (transfers (kinds as) [cf]) V) ∧
slice_edges S [] as = slice_edges S [] as' ∧
transfers (kinds as) [cf] ≠ [] ∧ m -as'→⇩√* m'"
proof(cases "slice_edges S [] as = []")
case True
hence "preds (slice_kinds S []) [cf]"
and "slice_edges S [] [] = slice_edges S [] as"
by(simp_all add:slice_kinds_def)
with ‹S,kind ⊢ ([m],[cf]) =slice_edges S [] as⇒* (ms'',s'')›
have [simp]:"ms'' = [m]" "s'' = [cf]" by(auto elim:trans_observable_moves.cases)
with ‹S,kind ⊢ (ms'',s'') =as'⇒⇩τ (m'#ms',transfers (kinds as) [cf])›
have "S,kind ⊢ ([m],[cf]) =as'⇒⇩τ (m'#ms',transfers (kinds as) [cf])"
by simp
with ‹valid_node m› have "m -as'→* m'" and "valid_path_aux [] as'"
by(auto intro:silent_moves_vpa_path[of _ _ _ _ _ _ _ _ _ "[]"]
simp:targetnodes_def valid_return_list_def)
hence "m -as'→⇩√* m'" by(simp add:vp_def valid_path_def)
from ‹S,kind ⊢ ([m],[cf]) =as'⇒⇩τ (m'#ms',transfers (kinds as) [cf])›
have "slice_edges S [] as' = []"
by(fastforce dest:silent_moves_no_slice_edges[where cs="[]" and rs="[]"]
simp:targetnodes_def)
from ‹S,kind ⊢ ([m],[cf]) =as'⇒⇩τ (m'#ms',transfers (kinds as) [cf])›
‹valid_node m› ‹valid_node m'› ‹CFG_node m' ∈ S›
have returns:"∀mx ∈ set ms'.
∃mx'. call_of_return_node mx mx' ∧ mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙"
by -(erule silent_moves_called_node_in_slice1_nodestack_in_slice1
[of _ _ _ _ _ _ _ _ _ "[]" "[]"],
auto intro:refl_slice1 simp:targetnodes_def valid_return_list_def)
from ‹S,kind ⊢ ([m],[cf]) =as'⇒⇩τ (m'#ms',transfers (kinds as) [cf])›
‹(([m],[cf]),([m],[cf])) ∈ WS S›
have WS:"((m'#ms',transfers (kinds as) [cf]),([m],[cf])) ∈ WS S"
by(rule WS_silent_moves)
hence "transfers (kinds as) [cf] ≠ []" by(auto elim!:WS.cases)
with WS returns ‹transfers (kinds as) [cf] ≠ []›
have "∀V ∈ rv S (CFG_node m').
state_val (transfers (kinds as) [cf]) V = fst cf V"
apply - apply(erule WS.cases) apply clarsimp
by(case_tac msx)(auto simp:hd_conv_nth)
with ‹∀V ∈ Use m'. V ∈ rv S (CFG_node m')›
have Uses:"∀V ∈ Use m'. state_val (transfers (kinds as) [cf]) V = fst cf V"
by simp
have [simp]:"ms' = []"
proof(rule ccontr)
assume "ms' ≠ []"
with ‹S,kind ⊢ ([m],[cf]) =as'⇒⇩τ (m'#ms',transfers (kinds as) [cf])›
‹valid_node m› ‹valid_node m'› ‹CFG_node m' ∈ S›
show False
by(fastforce elim:silent_moves_nonempty_nodestack_False intro:refl_slice1)
qed
with ‹S,kind ⊢ ([m],[cf]) =as'⇒⇩τ (m'#ms',transfers (kinds as) [cf])›
have "S,kind ⊢ ([m],[cf]) =as'⇒⇩τ ([m'],transfers (kinds as) [cf])"
by simp
with ‹valid_node m› have "m -as'→⇘sl⇙* m'" by(fastforce dest:silent_moves_slp)
from this ‹slice_edges S [] as' = []›
obtain asx where "m -asx→⇩ι* m'" and "slice_edges S [] asx = []"
by(erule slp_to_intra_path_with_slice_edges)
with ‹CFG_node m' ∈ HRB_slice S›
obtain asx' where "m -asx'→⇩ι* m'"
and "preds (slice_kinds S asx') [cf]"
and "slice_edges S [] asx' = []"
by -(erule exists_sliced_intra_path_preds,auto simp:SDG_to_CFG_set_def)
from ‹m -asx'→⇩ι* m'› have "m -asx'→⇩√* m'" by(rule intra_path_vp)
from Uses ‹slice_edges S [] asx' = []›
have "hd (transfers (slice_kinds S
(slice_edges S [] asx')) [cf]) = cf" by(simp add:slice_kinds_def)
from ‹m -asx'→⇩ι* m'› ‹CFG_node m' ∈ S›
have "transfers (slice_kinds S (slice_edges S [] asx')) [cf] =
transfers (slice_kinds S asx') [cf]"
by(fastforce intro:transfers_intra_slice_kinds_slice_edges simp:intra_path_def)
with ‹hd (transfers (slice_kinds S (slice_edges S [] asx')) [cf]) = cf›
have "hd (transfers (slice_kinds S asx') [cf]) = cf" by simp
with Uses have "∀V∈Use m'. state_val (transfers (slice_kinds S asx') [cf]) V =
state_val (transfers (kinds as) [cf]) V" by simp
with ‹m -asx'→⇩√* m'› ‹preds (slice_kinds S asx') [cf]›
‹slice_edges S [] asx' = []› ‹transfers (kinds as) [cf] ≠ []› True
show ?thesis by fastforce
next
case False
with ‹(([m],[cf]),([m],[cf])) ∈ WS S›
‹S,kind ⊢ ([m],[cf]) =slice_edges S [] as⇒* (ms'',s'')›
have WS:"((ms'',s''),(ms'',transfers (slice_kinds S (slice_edges S [] as)) [cf]))
∈ WS S"
and tom:"S,slice_kind S ⊢ ([m],[cf]) =slice_edges S [] as⇒*
(ms'',transfers (slice_kinds S (slice_edges S [] as)) [cf])"
by(fastforce dest:WS_weak_sim_trans)+
from WS obtain mx msx where [simp]:"ms'' = mx#msx" and "valid_node mx"
by -(erule WS.cases,cases ms'',auto)
from ‹S,kind ⊢ (ms'',s'') =as'⇒⇩τ (m'#ms',transfers (kinds as) [cf])› WS
have WS':"((m'#ms',transfers (kinds as) [cf]),
(mx#msx,transfers (slice_kinds S (slice_edges S [] as)) [cf])) ∈ WS S"
by simp(rule WS_silent_moves)
from tom ‹valid_node m›
obtain asx csx rsx where "preds (slice_kinds S asx) [cf]"
and "slice_edges S [] asx = slice_edges S [] as"
and "m -asx→⇩√* mx" and "transfers (slice_kinds S asx) [cf] ≠ []"
and "upd_cs [] asx = csx" and stack:"valid_node mx" "valid_call_list csx mx"
"∀i < length rsx. rsx!i ∈ get_return_edges (csx!i)"
"valid_return_list rsx mx" "length rsx = length csx"
"msx = targetnodes rsx"
and trans_eq:"transfers (slice_kinds S
(slice_edges S [] asx)) [cf] =
transfers (slice_kinds S asx) [cf]"
by(auto elim:slice_tom_preds_vp[of _ _ _ _ _ _ _ _ "[]" "[]"]
simp:valid_call_list_def valid_return_list_def targetnodes_def
vp_def valid_path_def)
from ‹transfers (slice_kinds S asx) [cf] ≠ []›
obtain cf' cfs' where eq:"transfers (slice_kinds S asx) [cf] =
cf'#cfs'" by(cases "transfers (slice_kinds S asx) [cf]") auto
from WS' have callstack:"∀mx ∈ set msx. ∃mx'. call_of_return_node mx mx' ∧
mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙"
by(fastforce elim:WS.cases)
with ‹S,kind ⊢ (ms'',s'') =as'⇒⇩τ (m'#ms',transfers (kinds as) [cf])›
‹valid_node m'› stack ‹CFG_node m' ∈ S›
have callstack':"∀mx ∈ set ms'. ∃mx'. call_of_return_node mx mx' ∧
mx' ∈ ⌊HRB_slice S⌋⇘CFG⇙"
by simp(erule silent_moves_called_node_in_slice1_nodestack_in_slice1
[of _ _ _ _ _ _ _ _ _ rsx csx],auto intro:refl_slice1)
with ‹S,kind ⊢ (ms'',s'') =as'⇒⇩τ (m'#ms',transfers (kinds as) [cf])›
stack callstack
have "mx -as'→⇘sl⇙* m'" and "msx = ms'" by(auto dest!:silent_moves_slp)
from ‹S,kind ⊢ (ms'',s'') =as'⇒⇩τ (m'#ms',transfers (kinds as) [cf])›
stack
have "slice_edges S csx as' = []"
by(auto dest:silent_moves_no_slice_edges[OF _ _ _ stacks_rewrite])
with ‹mx -as'→⇘sl⇙* m'› obtain asx'' where "mx -asx''→⇩ι* m'"
and "slice_edges S csx asx'' = []"
by(erule slp_to_intra_path_with_slice_edges)
from stack have "∀i<length csx. call_of_return_node (msx!i) (sourcenode (csx!i))"
by -(rule stacks_rewrite)
with callstack ‹msx = targetnodes rsx› ‹length rsx = length csx›
have "∀c∈set csx. sourcenode c ∈ ⌊HRB_slice S⌋⇘CFG⇙"
by(auto simp:all_set_conv_all_nth targetnodes_def)
with ‹mx -asx''→⇩ι* m'› ‹slice_edges S csx asx'' = []› ‹valid_node m'›
eq ‹CFG_node m' ∈ S›
obtain asx' where "mx -asx'→⇩ι* m'"
and "preds (slice_kinds S asx') (cf'#cfs')"
and "slice_edges S csx asx' = []"
by -(erule exists_sliced_intra_path_preds,
auto intro:HRB_slice_refl simp:SDG_to_CFG_set_def)
with eq have "preds (slice_kinds S asx')
(transfers (slice_kinds S asx) [cf])" by simp
with ‹preds (slice_kinds S asx) [cf]›
have "preds (slice_kinds S (asx@asx')) [cf]"
by(simp add:slice_kinds_def preds_split)
from ‹m -asx→⇩√* mx› ‹mx -asx'→⇩ι* m'› have "m -asx@asx'→⇩√* m'"
by(fastforce elim:vp_slp_Append intra_path_slp)
from ‹upd_cs [] asx = csx› ‹slice_edges S csx asx' = []›
have "slice_edges S [] (asx@asx') =
(slice_edges S [] asx)@[]"
by(fastforce intro:slice_edges_Append)
from ‹mx -asx'→⇩ι* m'› ‹∀c∈set csx. sourcenode c ∈ ⌊HRB_slice S⌋⇘CFG⇙›
have trans_eq':"transfers (slice_kinds S (slice_edges S csx asx'))
(transfers (slice_kinds S asx) [cf]) =
transfers (slice_kinds S asx') (transfers (slice_kinds S asx) [cf])"
by(fastforce intro:transfers_intra_slice_kinds_slice_edges simp:intra_path_def)
from ‹upd_cs [] asx = csx›
have "slice_edges S [] (asx@asx') =
(slice_edges S [] asx)@(slice_edges S csx asx')"
by(fastforce intro:slice_edges_Append)
hence "transfers (slice_kinds S (slice_edges S [] (asx@asx'))) [cf] =
transfers (slice_kinds S (slice_edges S csx asx'))
(transfers (slice_kinds S (slice_edges S [] asx)) [cf])"
by(simp add:slice_kinds_def transfers_split)
with trans_eq have "transfers (slice_kinds S (slice_edges S [] (asx@asx'))) [cf] =
transfers (slice_kinds S (slice_edges S csx asx'))
(transfers (slice_kinds S asx) [cf])" by simp
with trans_eq' have trans_eq'':
"transfers (slice_kinds S (slice_edges S [] (asx@asx'))) [cf] =
transfers (slice_kinds S (asx@asx')) [cf]"
by(simp add:slice_kinds_def transfers_split)
from WS' obtain x xs where "m'#ms' = xs@x#msx"
and "xs ≠ [] ⟶ (∃mx'. call_of_return_node x mx' ∧
mx' ∉ ⌊HRB_slice S⌋⇘CFG⇙)"
and rest:"∀i < length (mx#msx). ∀V ∈ rv S (CFG_node ((x#msx)!i)).
(fst ((transfers (kinds as) [cf])!(length xs + i))) V =
(fst ((transfers (slice_kinds S
(slice_edges S [] as)) [cf])!i)) V"
"transfers (kinds as) [cf] ≠ []"
"transfers (slice_kinds S
(slice_edges S [] as)) [cf] ≠ []"
by(fastforce elim:WS.cases)
from ‹m'#ms' = xs@x#msx› ‹xs ≠ [] ⟶ (∃mx'. call_of_return_node x mx' ∧
mx' ∉ ⌊HRB_slice S⌋⇘CFG⇙)› callstack'
have [simp]:"xs = []" "x = m'" "ms' = msx" by(cases xs,auto)+
from rest have "∀V ∈ rv S (CFG_node m').
state_val (transfers (kinds as) [cf]) V =
state_val (transfers (slice_kinds S (slice_edges S [] as)) [cf]) V"
by(fastforce dest:hd_conv_nth)
with ‹∀V ∈ Use m'. V ∈ rv S (CFG_node m')›
‹slice_edges S [] asx = slice_edges S [] as›
have "∀V ∈ Use m'. state_val (transfers (kinds as) [cf]) V =
state_val (transfers (slice_kinds S (slice_edges S [] asx)) [cf]) V"
by simp
with ‹slice_edges S [] (asx@asx') = (slice_edges S [] asx)@[]›
have "∀V ∈ Use m'. state_val (transfers (kinds as) [cf]) V =
state_val (transfers (slice_kinds S (slice_edges S [] (asx@asx'))) [cf]) V"
by simp
with trans_eq'' have "∀V ∈ Use m'. state_val (transfers (kinds as) [cf]) V =
state_val (transfers (slice_kinds S (asx@asx')) [cf]) V"
by simp
with ‹preds (slice_kinds S (asx@asx')) [cf]›
‹m -asx@asx'→⇩√* m'› ‹slice_edges S [] (asx@asx') =
(slice_edges S [] asx)@[]› ‹transfers (kinds as) [cf] ≠ []›
‹slice_edges S [] asx = slice_edges S [] as›
show ?thesis by fastforce
qed
qed
end
subsection ‹The fundamental property of static interprocedural slicing related to the semantics›
locale SemanticsProperty = SDG sourcenode targetnode kind valid_edge Entry
get_proc get_return_edges procs Main Exit Def Use ParamDefs ParamUses +
CFG_semantics_wf sourcenode targetnode kind valid_edge Entry
get_proc get_return_edges procs Main sem identifies
for sourcenode :: "'edge ⇒ 'node" and targetnode :: "'edge ⇒ 'node"
and kind :: "'edge ⇒ ('var,'val,'ret,'pname) edge_kind"
and valid_edge :: "'edge ⇒ bool"
and Entry :: "'node" ("'('_Entry'_')") and get_proc :: "'node ⇒ 'pname"
and get_return_edges :: "'edge ⇒ 'edge set"
and procs :: "('pname × 'var list × 'var list) list" and Main :: "'pname"
and Exit::"'node" ("'('_Exit'_')")
and Def :: "'node ⇒ 'var set" and Use :: "'node ⇒ 'var set"
and ParamDefs :: "'node ⇒ 'var list" and ParamUses :: "'node ⇒ 'var set list"
and sem :: "'com ⇒ ('var ⇀ 'val) list ⇒ 'com ⇒ ('var ⇀ 'val) list ⇒ bool"
("((1⟨_,/_⟩) ⇒/ (1⟨_,/_⟩))" [0,0,0,0] 81)
and identifies :: "'node ⇒ 'com ⇒ bool" ("_ ≜ _" [51,0] 80)
begin
theorem fundamental_property_of_path_slicing_semantically:
assumes "m ≜ c" and "⟨c,[cf]⟩ ⇒ ⟨c',s'⟩"
obtains m' as cfs' where "m -as→⇩√* m'" and "m' ≜ c'"
and "preds (slice_kinds {CFG_node m'} as) [(cf,undefined)]"
and "∀V ∈ Use m'.
state_val (transfers (slice_kinds {CFG_node m'} as) [(cf,undefined)]) V =
state_val cfs' V" and "map fst cfs' = s'"
proof(atomize_elim)
from ‹m ≜ c› ‹⟨c,[cf]⟩ ⇒ ⟨c',s'⟩› obtain m' as cfs' where "m -as→⇩√* m'"
and "transfers (kinds as) [(cf,undefined)] = cfs'"
and "preds (kinds as) [(cf,undefined)]" and "m' ≜ c'" and "map fst cfs' = s'"
by(fastforce dest:fundamental_property)
from ‹m -as→⇩√* m'› ‹preds (kinds as) [(cf,undefined)]› obtain as'
where "preds (slice_kinds {CFG_node m'} as') [(cf,undefined)]"
and vals:"∀V ∈ Use m'. state_val (transfers (slice_kinds {CFG_node m'} as')
[(cf,undefined)]) V = state_val (transfers (kinds as) [(cf,undefined)]) V"
and "m -as'→⇩√* m'"
by -(erule fundamental_property_of_static_slicing,auto)
from ‹transfers (kinds as) [(cf,undefined)] = cfs'› vals have "∀V ∈ Use m'.
state_val (transfers (slice_kinds {CFG_node m'} as') [(cf,undefined)]) V =
state_val cfs' V" by simp
with ‹preds (slice_kinds {CFG_node m'} as') [(cf,undefined)]› ‹m -as'→⇩√* m'›
‹m' ≜ c'› ‹map fst cfs' = s'›
show "∃as m' cfs'. m -as→⇩√* m' ∧ m' ≜ c' ∧
preds (slice_kinds {CFG_node m'} as) [(cf, undefined)] ∧
(∀V∈Use m'. state_val (transfers (slice_kinds {CFG_node m'} as)
[(cf, undefined)]) V = state_val cfs' V) ∧ map fst cfs' = s'"
by blast
qed
end
end
Theory Com
chapter ‹Instantiating the Framework with a simple While-Language using procedures›
section ‹Commands›
theory Com imports "../StaticInter/BasicDefs" begin
subsection ‹Variables and Values›
type_synonym vname = string
type_synonym pname = string
datatype val
= Bool bool
| Intg int
abbreviation "true == Bool True"
abbreviation "false == Bool False"
subsection ‹Expressions›
datatype bop = Eq | And | Less | Add | Sub
datatype expr
= Val val
| Var vname
| BinOp expr bop expr ("_ «_» _" [80,0,81] 80)
fun binop :: "bop ⇒ val ⇒ val ⇒ val option"
where "binop Eq v⇩1 v⇩2 = Some(Bool(v⇩1 = v⇩2))"
| "binop And (Bool b⇩1) (Bool b⇩2) = Some(Bool(b⇩1 ∧ b⇩2))"
| "binop Less (Intg i⇩1) (Intg i⇩2) = Some(Bool(i⇩1 < i⇩2))"
| "binop Add (Intg i⇩1) (Intg i⇩2) = Some(Intg(i⇩1 + i⇩2))"
| "binop Sub (Intg i⇩1) (Intg i⇩2) = Some(Intg(i⇩1 - i⇩2))"
| "binop bop v⇩1 v⇩2 = None"
subsection ‹Commands›
datatype cmd
= Skip
| LAss vname expr ("_:=_" [70,70] 70)
| Seq cmd cmd ("_;;/ _" [60,61] 60)
| Cond expr cmd cmd ("if '(_') _/ else _" [80,79,79] 70)
| While expr cmd ("while '(_') _" [80,79] 70)
| Call pname "expr list" "vname list"
fun num_inner_nodes :: "cmd ⇒ nat" ("#:_")
where "#:Skip = 1"
| "#:(V:=e) = 2"
| "#:(c⇩1;;c⇩2) = #:c⇩1 + #:c⇩2"
| "#:(if (b) c⇩1 else c⇩2) = #:c⇩1 + #:c⇩2 + 1"
| "#:(while (b) c) = #:c + 2"
| "#:(Call p es rets) = 2"
lemma num_inner_nodes_gr_0 [simp]:"#:c > 0"
by(induct c) auto
lemma [dest]:"#:c = 0 ⟹ False"
by(induct c) auto
end
Theory ProcState
section ‹The state›
theory ProcState imports Com begin
fun "interpret" :: "expr ⇒ (vname ⇀ val) ⇒ val option"
where Val: "interpret (Val v) cf = Some v"
| Var: "interpret (Var V) cf = cf V"
| BinOp: "interpret (e⇩1«bop»e⇩2) cf =
(case interpret e⇩1 cf of None ⇒ None
| Some v⇩1 ⇒ (case interpret e⇩2 cf of None ⇒ None
| Some v⇩2 ⇒ (
case binop bop v⇩1 v⇩2 of None ⇒ None | Some v ⇒ Some v)))"
abbreviation update :: "(vname ⇀ val) ⇒ vname ⇒ expr ⇒ (vname ⇀ val)"
where "update cf V e ≡ cf(V:=(interpret e cf))"
abbreviation state_check :: "(vname ⇀ val) ⇒ expr ⇒ val option ⇒ bool"
where "state_check cf b v ≡ (interpret b cf = v)"
end
Theory PCFG
section ‹Definition of the CFG›
theory PCFG imports ProcState begin
definition Main :: "pname"
where "Main = ''Main''"
datatype label = Label nat | Entry | Exit
subsection‹The CFG for every procedure›
subsubsection ‹Definition of ‹⊕››
fun label_incr :: "label ⇒ nat ⇒ label" ("_ ⊕ _" 60)
where "(Label l) ⊕ i = Label (l + i)"
| "Entry ⊕ i = Entry"
| "Exit ⊕ i = Exit"
lemma Exit_label_incr [dest]: "Exit = n ⊕ i ⟹ n = Exit"
by(cases n,auto)
lemma label_incr_Exit [dest]: "n ⊕ i = Exit ⟹ n = Exit"
by(cases n,auto)
lemma Entry_label_incr [dest]: "Entry = n ⊕ i ⟹ n = Entry"
by(cases n,auto)
lemma label_incr_Entry [dest]: "n ⊕ i = Entry ⟹ n = Entry"
by(cases n,auto)
lemma label_incr_inj:
"n ⊕ c = n' ⊕ c ⟹ n = n'"
by(cases n)(cases n',auto)+
lemma label_incr_simp:"n ⊕ i = m ⊕ (i + j) ⟹ n = m ⊕ j"
by(cases n,auto,cases m,auto)
lemma label_incr_simp_rev:"m ⊕ (j + i) = n ⊕ i ⟹ m ⊕ j = n"
by(cases n,auto,cases m,auto)
lemma label_incr_start_Node_smaller:
"Label l = n ⊕ i ⟹ n = Label (l - i)"
by(cases n,auto)
lemma label_incr_start_Node_smaller_rev:
"n ⊕ i = Label l ⟹ n = Label (l - i)"
by(cases n,auto)
lemma label_incr_ge:"Label l = n ⊕ i ⟹ l ≥ i"
by(cases n) auto
lemma label_incr_0 [dest]:
"⟦Label 0 = n ⊕ i; i > 0⟧ ⟹ False"
by(cases n) auto
lemma label_incr_0_rev [dest]:
"⟦n ⊕ i = Label 0; i > 0⟧ ⟹ False"
by(cases n) auto
subsubsection ‹The edges of the procedure CFG›
text ‹Control flow information in this language is the node, to which we return
after the calles procedure is finished.›
datatype p_edge_kind =
IEdge "(vname,val,pname × label,pname) edge_kind"
| CEdge "pname × expr list × vname list"
type_synonym p_edge = "(label × p_edge_kind × label)"
inductive Proc_CFG :: "cmd ⇒ label ⇒ p_edge_kind ⇒ label ⇒ bool"
("_ ⊢ _ -_→⇩p _")
where
Proc_CFG_Entry_Exit:
"prog ⊢ Entry -IEdge (λs. False)⇩√→⇩p Exit"
| Proc_CFG_Entry:
"prog ⊢ Entry -IEdge (λs. True)⇩√→⇩p Label 0"
| Proc_CFG_Skip:
"Skip ⊢ Label 0 -IEdge ⇑id→⇩p Exit"
| Proc_CFG_LAss:
"V:=e ⊢ Label 0 -IEdge ⇑(λcf. update cf V e)→⇩p Label 1"
| Proc_CFG_LAssSkip:
"V:=e ⊢ Label 1 -IEdge ⇑id→⇩p Exit"
| Proc_CFG_SeqFirst:
"⟦c⇩1 ⊢ n -et→⇩p n'; n' ≠ Exit⟧ ⟹ c⇩1;;c⇩2 ⊢ n -et→⇩p n'"
| Proc_CFG_SeqConnect:
"⟦c⇩1 ⊢ n -et→⇩p Exit; n ≠ Entry⟧ ⟹ c⇩1;;c⇩2 ⊢ n -et→⇩p Label #:c⇩1"
| Proc_CFG_SeqSecond:
"⟦c⇩2 ⊢ n -et→⇩p n'; n ≠ Entry⟧ ⟹ c⇩1;;c⇩2 ⊢ n ⊕ #:c⇩1 -et→⇩p n' ⊕ #:c⇩1"
| Proc_CFG_CondTrue:
"if (b) c⇩1 else c⇩2 ⊢ Label 0
-IEdge (λcf. state_check cf b (Some true))⇩√→⇩p Label 1"
| Proc_CFG_CondFalse:
"if (b) c⇩1 else c⇩2 ⊢ Label 0 -IEdge (λcf. state_check cf b (Some false))⇩√→⇩p
Label (#:c⇩1 + 1)"
| Proc_CFG_CondThen:
"⟦c⇩1 ⊢ n -et→⇩p n'; n ≠ Entry⟧ ⟹ if (b) c⇩1 else c⇩2 ⊢ n ⊕ 1 -et→⇩p n' ⊕ 1"
| Proc_CFG_CondElse:
"⟦c⇩2 ⊢ n -et→⇩p n'; n ≠ Entry⟧
⟹ if (b) c⇩1 else c⇩2 ⊢ n ⊕ (#:c⇩1 + 1) -et→⇩p n' ⊕ (#:c⇩1 + 1)"
| Proc_CFG_WhileTrue:
"while (b) c' ⊢ Label 0 -IEdge (λcf. state_check cf b (Some true))⇩√→⇩p Label 2"
| Proc_CFG_WhileFalse:
"while (b) c' ⊢ Label 0 -IEdge (λcf. state_check cf b (Some false))⇩√→⇩p Label 1"
| Proc_CFG_WhileFalseSkip:
"while (b) c' ⊢ Label 1 -IEdge ⇑id→⇩p Exit"
| Proc_CFG_WhileBody:
"⟦c' ⊢ n -et→⇩p n'; n ≠ Entry; n' ≠ Exit⟧
⟹ while (b) c' ⊢ n ⊕ 2 -et→⇩p n' ⊕ 2"
| Proc_CFG_WhileBodyExit:
"⟦c' ⊢ n -et→⇩p Exit; n ≠ Entry⟧ ⟹ while (b) c' ⊢ n ⊕ 2 -et→⇩p Label 0"
| Proc_CFG_Call:
"Call p es rets ⊢ Label 0 -CEdge (p,es,rets)→⇩p Label 1"
| Proc_CFG_CallSkip:
"Call p es rets ⊢ Label 1 -IEdge ⇑id→⇩p Exit"
subsubsection‹Some lemmas about the procedure CFG›
lemma Proc_CFG_Exit_no_sourcenode [dest]:
"prog ⊢ Exit -et→⇩p n' ⟹ False"
by(induct prog n≡"Exit" et n' rule:Proc_CFG.induct,auto)
lemma Proc_CFG_Entry_no_targetnode [dest]:
"prog ⊢ n -et→⇩p Entry ⟹ False"
by(induct prog n et n'≡"Entry" rule:Proc_CFG.induct,auto)
lemma Proc_CFG_IEdge_intra_kind:
"prog ⊢ n -IEdge et→⇩p n' ⟹ intra_kind et"
by(induct prog n x≡"IEdge et" n' rule:Proc_CFG.induct,auto simp:intra_kind_def)
lemma [dest]:"prog ⊢ n -IEdge (Q:r↪⇘p⇙fs)→⇩p n' ⟹ False"
by(fastforce dest:Proc_CFG_IEdge_intra_kind simp:intra_kind_def)
lemma [dest]:"prog ⊢ n -IEdge (Q↩⇘p⇙f)→⇩p n' ⟹ False"
by(fastforce dest:Proc_CFG_IEdge_intra_kind simp:intra_kind_def)
lemma Proc_CFG_sourcelabel_less_num_nodes:
"prog ⊢ Label l -et→⇩p n' ⟹ l < #:prog"
proof(induct prog "Label l" et n' arbitrary:l rule:Proc_CFG.induct)
case (Proc_CFG_SeqFirst c⇩1 et n' c⇩2 l)
thus ?case by simp
next
case (Proc_CFG_SeqConnect c⇩1 et c⇩2 l)
thus ?case by simp
next
case (Proc_CFG_SeqSecond c⇩2 n et n' c⇩1 l)
note n = ‹n ⊕ #:c⇩1 = Label l›
note IH = ‹⋀l. n = Label l ⟹ l < #:c⇩2›
from n obtain l' where l':"n = Label l'" by(cases n) auto
from IH[OF this] have "l' < #:c⇩2" .
with n l' show ?case by simp
next
case (Proc_CFG_CondThen c⇩1 n et n' b c⇩2 l)
note n = ‹n ⊕ 1 = Label l›
note IH = ‹⋀l. n = Label l ⟹ l < #:c⇩1›
from n obtain l' where l':"n = Label l'" by(cases n) auto
from IH[OF this] have "l' < #:c⇩1" .
with n l' show ?case by simp
next
case (Proc_CFG_CondElse c⇩2 n et n' b c⇩1 l)
note n = ‹n ⊕ (#:c⇩1 + 1) = Label l›
note IH = ‹⋀l. n = Label l ⟹ l < #:c⇩2›
from n obtain l' where l':"n = Label l'" by(cases n) auto
from IH[OF this] have "l' < #:c⇩2" .
with n l' show ?case by simp
next
case (Proc_CFG_WhileBody c' n et n' b l)
note n = ‹n ⊕ 2 = Label l›
note IH = ‹⋀l. n = Label l ⟹ l < #:c'›
from n obtain l' where l':"n = Label l'" by(cases n) auto
from IH[OF this] have "l' < #:c'" .
with n l' show ?case by simp
next
case (Proc_CFG_WhileBodyExit c' n et b l)
note n = ‹n ⊕ 2 = Label l›
note IH = ‹⋀l. n = Label l ⟹ l < #:c'›
from n obtain l' where l':"n = Label l'" by(cases n) auto
from IH[OF this] have "l' < #:c'" .
with n l' show ?case by simp
qed (auto simp:num_inner_nodes_gr_0)
lemma Proc_CFG_targetlabel_less_num_nodes:
"prog ⊢ n -et→⇩p Label l ⟹ l < #:prog"
proof(induct prog n et "Label l" arbitrary:l rule:Proc_CFG.induct)
case (Proc_CFG_SeqFirst c⇩1 n et c⇩2 l)
thus ?case by simp
next
case (Proc_CFG_SeqSecond c⇩2 n et n' c⇩1 l)
note n' = ‹n' ⊕ #:c⇩1 = Label l›
note IH = ‹⋀l. n' = Label l ⟹ l < #:c⇩2›
from n' obtain l' where l':"n' = Label l'" by(cases n') auto
from IH[OF this] have "l' < #:c⇩2" .
with n' l' show ?case by simp
next
case (Proc_CFG_CondThen c⇩1 n et n' b c⇩2 l)
note n' = ‹n' ⊕ 1 = Label l›
note IH = ‹⋀l. n' = Label l ⟹ l < #:c⇩1›
from n' obtain l' where l':"n' = Label l'" by(cases n') auto
from IH[OF this] have "l' < #:c⇩1" .
with n' l' show ?case by simp
next
case (Proc_CFG_CondElse c⇩2 n et n' b c⇩1 l)
note n' = ‹n' ⊕ (#:c⇩1 + 1) = Label l›
note IH = ‹⋀l. n' = Label l ⟹ l < #:c⇩2›
from n' obtain l' where l':"n' = Label l'" by(cases n') auto
from IH[OF this] have "l' < #:c⇩2" .
with n' l' show ?case by simp
next
case (Proc_CFG_WhileBody c' n et n' b l)
note n' = ‹n' ⊕ 2 = Label l›
note IH = ‹⋀l. n' = Label l ⟹ l < #:c'›
from n' obtain l' where l':"n' = Label l'" by(cases n') auto
from IH[OF this] have "l' < #:c'" .
with n' l' show ?case by simp
qed (auto simp:num_inner_nodes_gr_0)
lemma Proc_CFG_EntryD:
"prog ⊢ Entry -et→⇩p n'
⟹ (n' = Exit ∧ et = IEdge(λs. False)⇩√) ∨ (n' = Label 0 ∧ et = IEdge (λs. True)⇩√)"
by(induct prog n≡"Entry" et n' rule:Proc_CFG.induct,auto)
lemma Proc_CFG_Exit_edge:
obtains l et where "prog ⊢ Label l -IEdge et→⇩p Exit" and "l ≤ #:prog"
proof(atomize_elim)
show "∃l et. prog ⊢ Label l -IEdge et→⇩p Exit ∧ l ≤ #:prog"
proof(induct prog)
case Skip
have "Skip ⊢ Label 0 -IEdge ⇑id→⇩p Exit" by(rule Proc_CFG_Skip)
thus ?case by fastforce
next
case (LAss V e)
have "V:=e ⊢ Label 1 -IEdge ⇑id→⇩p Exit" by(rule Proc_CFG_LAssSkip)
thus ?case by fastforce
next
case (Seq c⇩1 c⇩2)
from ‹∃l et. c⇩2 ⊢ Label l -IEdge et→⇩p Exit ∧ l ≤ #:c⇩2›
obtain l et where "c⇩2 ⊢ Label l -IEdge et→⇩p Exit" and "l ≤ #:c⇩2" by blast
hence "c⇩1;;c⇩2 ⊢ Label l ⊕ #:c⇩1 -IEdge et→⇩p Exit ⊕ #:c⇩1"
by(fastforce intro:Proc_CFG_SeqSecond)
with ‹l ≤ #:c⇩2› show ?case by fastforce
next
case (Cond b c⇩1 c⇩2)
from ‹∃l et. c⇩1 ⊢ Label l -IEdge et→⇩p Exit ∧ l ≤ #:c⇩1›
obtain l et where "c⇩1 ⊢ Label l -IEdge et→⇩p Exit" and "l ≤ #:c⇩1" by blast
hence "if (b) c⇩1 else c⇩2 ⊢ Label l ⊕ 1 -IEdge et→⇩p Exit ⊕ 1"
by(fastforce intro:Proc_CFG_CondThen)
with ‹l ≤ #:c⇩1› show ?case by fastforce
next
case (While b c')
have "while (b) c' ⊢ Label 1 -IEdge ⇑id→⇩p Exit" by(rule Proc_CFG_WhileFalseSkip)
thus ?case by fastforce
next
case (Call p es rets)
have "Call p es rets ⊢ Label 1 -IEdge ⇑id→⇩p Exit" by(rule Proc_CFG_CallSkip)
thus ?case by fastforce
qed
qed
text ‹Lots of lemmas for call edges ‹…››
lemma Proc_CFG_Call_Labels:
"prog ⊢ n -CEdge (p,es,rets)→⇩p n' ⟹ ∃l. n = Label l ∧ n' = Label (Suc l)"
by(induct prog n et≡"CEdge (p,es,rets)" n' rule:Proc_CFG.induct,auto)
lemma Proc_CFG_Call_target_0:
"prog ⊢ n -CEdge (p,es,rets)→⇩p Label 0 ⟹ n = Entry"
by(induct prog n et≡"CEdge (p,es,rets)" n'≡"Label 0" rule:Proc_CFG.induct)
(auto dest:Proc_CFG_Call_Labels)
lemma Proc_CFG_Call_Intra_edge_not_same_source:
"⟦prog ⊢ n -CEdge (p,es,rets)→⇩p n'; prog ⊢ n -IEdge et→⇩p n''⟧ ⟹ False"
proof(induct prog n "CEdge (p,es,rets)" n' arbitrary:n'' rule:Proc_CFG.induct)
case (Proc_CFG_SeqFirst c⇩1 n n' c⇩2)
note IH = ‹⋀n''. c⇩1 ⊢ n -IEdge et→⇩p n'' ⟹ False›
from ‹c⇩1;;c⇩2 ⊢ n -IEdge et→⇩p n''› ‹c⇩1 ⊢ n -CEdge (p, es, rets)→⇩p n'›
‹n' ≠ Exit›
obtain nx where "c⇩1 ⊢ n -IEdge et→⇩p nx"
apply - apply(erule Proc_CFG.cases)
apply(auto intro:Proc_CFG_Entry_Exit Proc_CFG_Entry)
by(case_tac n)(auto dest:Proc_CFG_sourcelabel_less_num_nodes)
then show ?case by (rule IH)
next
case (Proc_CFG_SeqConnect c⇩1 n c⇩2)
from ‹c⇩1 ⊢ n -CEdge (p, es, rets)→⇩p Exit›
show ?case by(fastforce dest:Proc_CFG_Call_Labels)
next
case (Proc_CFG_SeqSecond c⇩2 n n' c⇩1)
note IH = ‹⋀n''. c⇩2 ⊢ n -IEdge et→⇩p n'' ⟹ False›
from ‹c⇩1;;c⇩2 ⊢ n ⊕ #:c⇩1 -IEdge et→⇩p n''› ‹c⇩2 ⊢ n -CEdge (p, es, rets)→⇩p n'›
‹n ≠ Entry›
obtain nx where "c⇩2 ⊢ n -IEdge et→⇩p nx"
apply - apply(erule Proc_CFG.cases,auto)
apply(cases n) apply(auto dest:Proc_CFG_sourcelabel_less_num_nodes)
apply(cases n) apply(auto dest:Proc_CFG_sourcelabel_less_num_nodes)
by(cases n,auto,case_tac n,auto)
then show ?case by (rule IH)
next
case (Proc_CFG_CondThen c⇩1 n n' b c⇩2)
note IH = ‹⋀n''. c⇩1 ⊢ n -IEdge et→⇩p n'' ⟹ False›
from ‹if (b) c⇩1 else c⇩2 ⊢ n ⊕ 1 -IEdge et→⇩p n''› ‹c⇩1 ⊢ n -CEdge (p, es, rets)→⇩p n'›
‹n ≠ Entry›
obtain nx where "c⇩1 ⊢ n -IEdge et→⇩p nx"
apply - apply(erule Proc_CFG.cases,auto)
apply(cases n) apply auto apply(case_tac n) apply auto
apply(cases n) apply auto
by(case_tac n)(auto dest:Proc_CFG_sourcelabel_less_num_nodes)
then show ?case by (rule IH)
next
case (Proc_CFG_CondElse c⇩2 n n' b c⇩1)
note IH = ‹⋀n''. c⇩2 ⊢ n -IEdge et→⇩p n'' ⟹ False›
from ‹if (b) c⇩1 else c⇩2 ⊢ n ⊕ #:c⇩1 + 1 -IEdge et→⇩p n''› ‹c⇩2 ⊢ n -CEdge (p, es, rets)→⇩p n'›
‹n ≠ Entry›
obtain nx where "c⇩2 ⊢ n -IEdge et→⇩p nx"
apply - apply(erule Proc_CFG.cases,auto)
apply(cases n) apply auto
apply(case_tac n) apply(auto dest:Proc_CFG_sourcelabel_less_num_nodes)
by(cases n,auto,case_tac n,auto)
then show ?case by (rule IH)
next
case (Proc_CFG_WhileBody c' n n' b)
note IH = ‹⋀n''. c' ⊢ n -IEdge et→⇩p n'' ⟹ False›
from ‹while (b) c' ⊢ n ⊕ 2 -IEdge et→⇩p n''› ‹c' ⊢ n -CEdge (p, es, rets)→⇩p n'›
‹n ≠ Entry› ‹n' ≠ Exit›
obtain nx where "c' ⊢ n -IEdge et→⇩p nx"
apply - apply(erule Proc_CFG.cases,auto)
apply(drule label_incr_ge[OF sym]) apply simp
apply(cases n) apply auto apply(case_tac n) apply auto
by(cases n,auto,case_tac n,auto)
then show ?case by (rule IH)
next
case (Proc_CFG_WhileBodyExit c' n b)
from ‹c' ⊢ n -CEdge (p, es, rets)→⇩p Exit›
show ?case by(fastforce dest:Proc_CFG_Call_Labels)
next
case Proc_CFG_Call
from ‹Call p es rets ⊢ Label 0 -IEdge et→⇩p n''›
show ?case by(fastforce elim:Proc_CFG.cases)
qed
lemma Proc_CFG_Call_Intra_edge_not_same_target:
"⟦prog ⊢ n -CEdge (p,es,rets)→⇩p n'; prog ⊢ n'' -IEdge et→⇩p n'⟧ ⟹ False"
proof(induct prog n "CEdge (p,es,rets)" n' arbitrary:n'' rule:Proc_CFG.induct)
case (Proc_CFG_SeqFirst c⇩1 n n' c⇩2)
note IH = ‹⋀n''. c⇩1 ⊢ n'' -IEdge et→⇩p n' ⟹ False›
from ‹c⇩1;;c⇩2 ⊢ n'' -IEdge et→⇩p n'› ‹c⇩1 ⊢ n -CEdge (p, es, rets)→⇩p n'›
‹n' ≠ Exit›
have "c⇩1 ⊢ n'' -IEdge et→⇩p n'"
apply - apply(erule Proc_CFG.cases)
apply(auto intro:Proc_CFG_Entry dest:Proc_CFG_targetlabel_less_num_nodes)
by(case_tac n')(auto dest:Proc_CFG_targetlabel_less_num_nodes)
then show ?case by (rule IH)
next
case (Proc_CFG_SeqConnect c⇩1 n c⇩2)
from ‹c⇩1 ⊢ n -CEdge (p, es, rets)→⇩p Exit›
show ?case by(fastforce dest:Proc_CFG_Call_Labels)
next
case (Proc_CFG_SeqSecond c⇩2 n n' c⇩1)
note IH = ‹⋀n''. c⇩2 ⊢ n'' -IEdge et→⇩p n' ⟹ False›
from ‹c⇩1;;c⇩2 ⊢ n'' -IEdge et→⇩p n' ⊕ #:c⇩1› ‹c⇩2 ⊢ n -CEdge (p, es, rets)→⇩p n'›
‹n ≠ Entry›
obtain nx where "c⇩2 ⊢ nx -IEdge et→⇩p n'"
apply - apply(erule Proc_CFG.cases,auto)
apply(fastforce intro:Proc_CFG_Entry_Exit)
apply(cases n') apply(auto dest:Proc_CFG_targetlabel_less_num_nodes)
apply(cases n') apply(auto dest:Proc_CFG_Call_target_0)
apply(cases n') apply(auto dest:Proc_CFG_Call_Labels)
by(case_tac n') auto
then show ?case by (rule IH)
next
case (Proc_CFG_CondThen c⇩1 n n' b c⇩2)
note IH = ‹⋀n''. c⇩1 ⊢ n'' -IEdge et→⇩p n' ⟹ False›
from ‹if (b) c⇩1 else c⇩2 ⊢ n'' -IEdge et→⇩p n' ⊕ 1› ‹c⇩1 ⊢ n -CEdge (p, es, rets)→⇩p n'›
‹n ≠ Entry›
obtain nx where "c⇩1 ⊢ nx -IEdge et→⇩p n'"
apply - apply(erule Proc_CFG.cases,auto)
apply(cases n') apply(auto intro:Proc_CFG_Entry_Exit)
apply(cases n') apply(auto dest:Proc_CFG_Call_target_0)
apply(cases n') apply(auto dest:Proc_CFG_targetlabel_less_num_nodes)
apply(cases n') apply auto apply(case_tac n') apply auto
apply(cases n') apply auto
apply(case_tac n') apply(auto dest:Proc_CFG_targetlabel_less_num_nodes)
by(case_tac n')(auto dest:Proc_CFG_Call_Labels)
then show ?case by (rule IH)
next
case (Proc_CFG_CondElse c⇩2 n n' b c⇩1)
note IH = ‹⋀n''. c⇩2 ⊢ n'' -IEdge et→⇩p n' ⟹ False›
from ‹if (b) c⇩1 else c⇩2 ⊢ n'' -IEdge et→⇩p n' ⊕ #:c⇩1 + 1› ‹c⇩2 ⊢ n -CEdge (p, es, rets)→⇩p n'›
‹n ≠ Entry›
obtain nx where "c⇩2 ⊢ nx -IEdge et→⇩p n'"
apply - apply(erule Proc_CFG.cases,auto)
apply(cases n') apply(auto intro:Proc_CFG_Entry_Exit)
apply(cases n') apply(auto dest:Proc_CFG_Call_target_0)
apply(cases n') apply(auto dest:Proc_CFG_Call_target_0)
apply(cases n') apply auto
apply(case_tac n') apply(auto dest:Proc_CFG_targetlabel_less_num_nodes)
apply(case_tac n') apply(auto dest:Proc_CFG_Call_Labels)
by(cases n',auto,case_tac n',auto)
then show ?case by (rule IH)
next
case (Proc_CFG_WhileBody c' n n' b)
note IH = ‹⋀n''. c' ⊢ n'' -IEdge et→⇩p n' ⟹ False›
from ‹while (b) c' ⊢ n'' -IEdge et→⇩p n' ⊕ 2› ‹c' ⊢ n -CEdge (p, es, rets)→⇩p n'›
‹n ≠ Entry› ‹n' ≠ Exit›
obtain nx where "c' ⊢ nx -IEdge et→⇩p n'"
apply - apply(erule Proc_CFG.cases,auto)
apply(cases n') apply(auto dest:Proc_CFG_Call_target_0)
apply(cases n') apply auto
by(cases n',auto,case_tac n',auto)
then show ?case by (rule IH)
next
case (Proc_CFG_WhileBodyExit c' n b)
from ‹c' ⊢ n -CEdge (p, es, rets)→⇩p Exit›
show ?case by(fastforce dest:Proc_CFG_Call_Labels)
next
case Proc_CFG_Call
from ‹Call p es rets ⊢ n'' -IEdge et→⇩p Label 1›
show ?case by(fastforce elim:Proc_CFG.cases)
qed
lemma Proc_CFG_Call_nodes_eq:
"⟦prog ⊢ n -CEdge (p,es,rets)→⇩p n'; prog ⊢ n -CEdge (p',es',rets')→⇩p n''⟧
⟹ n' = n'' ∧ p = p' ∧ es = es' ∧ rets = rets'"
proof(induct prog n "CEdge (p,es,rets)" n' arbitrary:n'' rule:Proc_CFG.induct)
case (Proc_CFG_SeqFirst c⇩1 n n' c⇩2)
note IH = ‹⋀n''. c⇩1 ⊢ n -CEdge (p',es',rets')→⇩p n''
⟹ n' = n'' ∧ p = p' ∧ es = es' ∧ rets = rets'›
from ‹c⇩1;; c⇩2 ⊢ n -CEdge (p',es',rets')→⇩p n''› ‹c⇩1 ⊢ n -CEdge (p,es,rets)→⇩p n'›
have "c⇩1 ⊢ n -CEdge (p',es',rets')→⇩p n''"
apply - apply(erule Proc_CFG.cases,auto)
apply(fastforce dest:Proc_CFG_Call_Labels)
by(case_tac n,(fastforce dest:Proc_CFG_sourcelabel_less_num_nodes)+)
then show ?case by (rule IH)
next
case (Proc_CFG_SeqConnect c⇩1 n c⇩2)
from ‹c⇩1 ⊢ n -CEdge (p,es,rets)→⇩p Exit› have False
by(fastforce dest:Proc_CFG_Call_Labels)
thus ?case by simp
next
case (Proc_CFG_SeqSecond c⇩2 n n' c⇩1)
note IH = ‹⋀n''. c⇩2 ⊢ n -CEdge (p',es',rets')→⇩p n''
⟹ n' = n'' ∧ p = p' ∧ es = es' ∧ rets = rets'›
from ‹c⇩1;;c⇩2 ⊢ n ⊕ #:c⇩1 -CEdge (p',es',rets')→⇩p n''› ‹n ≠ Entry›
obtain nx where edge:"c⇩2 ⊢ n -CEdge (p',es',rets')→⇩p nx" and nx:"nx ⊕ #:c⇩1 = n''"
apply - apply(erule Proc_CFG.cases,auto)
by(cases n,auto dest:Proc_CFG_sourcelabel_less_num_nodes label_incr_inj)+
from edge have "n' = nx ∧ p = p' ∧ es = es' ∧ rets = rets'" by (rule IH)
with nx show ?case by auto
next
case (Proc_CFG_CondThen c⇩1 n n' b c⇩2)
note IH = ‹⋀n''. c⇩1 ⊢ n -CEdge (p',es',rets')→⇩p n''
⟹ n' = n'' ∧ p = p' ∧ es = es' ∧ rets = rets'›
from ‹if (b) c⇩1 else c⇩2 ⊢ n ⊕ 1 -CEdge (p',es',rets')→⇩p n''›
obtain nx where "c⇩1 ⊢ n -CEdge (p',es',rets')→⇩p nx ∧ nx ⊕ 1 = n''"
proof(rule Proc_CFG.cases)
fix c⇩2' nx etx nx' bx c⇩1'
assume "if (b) c⇩1 else c⇩2 = if (bx) c⇩1' else c⇩2'"
and "n ⊕ 1 = nx ⊕ #:c⇩1' + 1" and "nx ≠ Entry"
with ‹c⇩1 ⊢ n -CEdge (p,es,rets)→⇩p n'› obtain l where "n = Label l" and "l ≥ #:c⇩1"
by(cases n,auto,cases nx,auto)
with ‹c⇩1 ⊢ n -CEdge (p,es,rets)→⇩p n'› have False
by(fastforce dest:Proc_CFG_sourcelabel_less_num_nodes)
thus ?thesis by simp
qed (auto dest:label_incr_inj)
then obtain nx where edge:"c⇩1 ⊢ n -CEdge (p',es',rets')→⇩p nx"
and nx:"nx ⊕ 1 = n''" by blast
from IH[OF edge] nx show ?case by simp
next
case (Proc_CFG_CondElse c⇩2 n n' b c⇩1)
note IH = ‹⋀n''. c⇩2 ⊢ n -CEdge (p',es',rets')→⇩p n''
⟹ n' = n'' ∧ p = p' ∧ es = es' ∧ rets = rets'›
from ‹if (b) c⇩1 else c⇩2 ⊢ n ⊕ #:c⇩1 + 1 -CEdge (p',es',rets')→⇩p n''›
obtain nx where "c⇩2 ⊢ n -CEdge (p',es',rets')→⇩p nx ∧ nx ⊕ #:c⇩1 + 1 = n''"
proof(rule Proc_CFG.cases)
fix c⇩1' nx etx nx' bx c⇩2'
assume ifs:"if (b) c⇩1 else c⇩2 = if (bx) c⇩1' else c⇩2'"
and "n ⊕ #:c⇩1 + 1 = nx ⊕ 1" and "nx ≠ Entry"
and edge:"c⇩1' ⊢ nx -etx→⇩p nx'"
then obtain l where "nx = Label l" and "l ≥ #:c⇩1"
by(cases n,auto,cases nx,auto)
with edge ifs have False
by(fastforce dest:Proc_CFG_sourcelabel_less_num_nodes)
thus ?thesis by simp
qed (auto dest:label_incr_inj)
then obtain nx where edge:"c⇩2 ⊢ n -CEdge (p',es',rets')→⇩p nx"
and nx:"nx ⊕ #:c⇩1 + 1 = n''"
by blast
from IH[OF edge] nx show ?case by simp
next
case (Proc_CFG_WhileBody c' n n' b)
note IH = ‹⋀n''. c' ⊢ n -CEdge (p',es',rets')→⇩p n''
⟹ n' = n'' ∧ p = p' ∧ es = es' ∧ rets = rets'›
from ‹while (b) c' ⊢ n ⊕ 2 -CEdge (p',es',rets')→⇩p n''›
obtain nx where "c' ⊢ n -CEdge (p',es',rets')→⇩p nx ∧ nx ⊕ 2 = n''"
by(rule Proc_CFG.cases,auto dest:label_incr_inj Proc_CFG_Call_Labels)
then obtain nx where edge:"c' ⊢ n -CEdge (p',es',rets')→⇩p nx"
and nx:"nx ⊕ 2 = n''" by blast
from IH[OF edge] nx show ?case by simp
next
case (Proc_CFG_WhileBodyExit c' n b)
from ‹c' ⊢ n -CEdge (p,es,rets)→⇩p Exit› have False
by(fastforce dest:Proc_CFG_Call_Labels)
thus ?case by simp
next
case Proc_CFG_Call
from ‹Call p es rets ⊢ Label 0 -CEdge (p',es',rets')→⇩p n''›
have "p = p' ∧ es = es' ∧ rets = rets' ∧ n'' = Label 1"
by(auto elim:Proc_CFG.cases)
then show ?case by simp
qed
lemma Proc_CFG_Call_nodes_eq':
"⟦prog ⊢ n -CEdge (p,es,rets)→⇩p n'; prog ⊢ n'' -CEdge (p',es',rets')→⇩p n'⟧
⟹ n = n'' ∧ p = p' ∧ es = es' ∧ rets = rets'"
proof(induct prog n "CEdge (p,es,rets)" n' arbitrary:n'' rule:Proc_CFG.induct)
case (Proc_CFG_SeqFirst c⇩1 n n' c⇩2)
note IH = ‹⋀n''. c⇩1 ⊢ n'' -CEdge (p',es',rets')→⇩p n'
⟹ n = n'' ∧ p = p' ∧ es = es' ∧ rets = rets'›
from ‹c⇩1;;c⇩2 ⊢ n'' -CEdge (p',es',rets')→⇩p n'› ‹c⇩1 ⊢ n -CEdge (p,es,rets)→⇩p n'›
have "c⇩1 ⊢ n'' -CEdge (p',es',rets')→⇩p n'"
apply - apply(erule Proc_CFG.cases,auto)
apply(fastforce dest:Proc_CFG_Call_Labels)
by(case_tac n',auto dest:Proc_CFG_targetlabel_less_num_nodes Proc_CFG_Call_Labels)
then show ?case by (rule IH)
next
case (Proc_CFG_SeqConnect c⇩1 n c⇩2)
from ‹c⇩1 ⊢ n -CEdge (p,es,rets)→⇩p Exit› have False
by(fastforce dest:Proc_CFG_Call_Labels)
thus ?case by simp
next
case (Proc_CFG_SeqSecond c⇩2 n n' c⇩1)
note IH = ‹⋀n''. c⇩2 ⊢ n'' -CEdge (p',es',rets')→⇩p n'
⟹ n = n'' ∧ p = p' ∧ es = es' ∧ rets = rets'›
from ‹c⇩1;;c⇩2 ⊢ n'' -CEdge (p',es',rets')→⇩p n' ⊕ #:c⇩1›
obtain nx where edge:"c⇩2 ⊢ nx -CEdge (p',es',rets')→⇩p n'" and nx:"nx ⊕ #:c⇩1 = n''"
apply - apply(erule Proc_CFG.cases,auto)
by(cases n',
auto dest:Proc_CFG_targetlabel_less_num_nodes Proc_CFG_Call_Labels
label_incr_inj)
from edge have "n = nx ∧ p = p' ∧ es = es' ∧ rets = rets'" by (rule IH)
with nx show ?case by auto
next
case (Proc_CFG_CondThen c⇩1 n n' b c⇩2)
note IH = ‹⋀n''. c⇩1 ⊢ n'' -CEdge (p',es',rets')→⇩p n'
⟹ n = n'' ∧ p = p' ∧ es = es' ∧ rets = rets'›
from ‹if (b) c⇩1 else c⇩2 ⊢ n'' -CEdge (p',es',rets')→⇩p n' ⊕ 1›
obtain nx where "c⇩1 ⊢ nx -CEdge (p',es',rets')→⇩p n' ∧ nx ⊕ 1 = n''"
proof(cases)
case (Proc_CFG_CondElse nx nx')
from ‹n' ⊕ 1 = nx' ⊕ #:c⇩1 + 1›
‹c⇩1 ⊢ n -CEdge (p,es,rets)→⇩p n'›
obtain l where "n' = Label l" and "l ≥ #:c⇩1"
by(cases n', auto dest:Proc_CFG_Call_Labels,cases nx',auto)
with ‹c⇩1 ⊢ n -CEdge (p,es,rets)→⇩p n'› have False
by(fastforce dest:Proc_CFG_targetlabel_less_num_nodes)
thus ?thesis by simp
qed (auto dest:label_incr_inj)
then obtain nx where edge:"c⇩1 ⊢ nx -CEdge (p',es',rets')→⇩p n'"
and nx:"nx ⊕ 1 = n''"
by blast
from IH[OF edge] nx show ?case by simp
next
case (Proc_CFG_CondElse c⇩2 n n' b c⇩1)
note IH = ‹⋀n''. c⇩2 ⊢ n'' -CEdge (p',es',rets')→⇩p n'
⟹ n = n'' ∧ p = p' ∧ es = es' ∧ rets = rets'›
from ‹if (b) c⇩1 else c⇩2 ⊢ n'' -CEdge (p',es',rets')→⇩p n' ⊕ #:c⇩1 + 1›
obtain nx where "c⇩2 ⊢ nx -CEdge (p',es',rets')→⇩p n' ∧ nx ⊕ #:c⇩1 + 1 = n''"
proof(cases)
case (Proc_CFG_CondThen nx nx')
from ‹n' ⊕ #:c⇩1 + 1 = nx' ⊕ 1›
‹c⇩1 ⊢ nx -CEdge (p',es',rets')→⇩p nx'›
obtain l where "nx' = Label l" and "l ≥ #:c⇩1"
by(cases n',auto,cases nx',auto dest:Proc_CFG_Call_Labels)
with ‹c⇩1 ⊢ nx -CEdge (p',es',rets')→⇩p nx'›
have False by(fastforce dest:Proc_CFG_targetlabel_less_num_nodes)
thus ?thesis by simp
qed (auto dest:label_incr_inj)
then obtain nx where edge:"c⇩2 ⊢ nx -CEdge (p',es',rets')→⇩p n'"
and nx:"nx ⊕ #:c⇩1 + 1 = n''"
by blast
from IH[OF edge] nx show ?case by simp
next
case (Proc_CFG_WhileBody c' n n' b)
note IH = ‹⋀n''. c' ⊢ n'' -CEdge (p',es',rets')→⇩p n'
⟹ n = n'' ∧ p = p' ∧ es = es' ∧ rets = rets'›
from ‹while (b) c' ⊢ n'' -CEdge (p',es',rets')→⇩p n' ⊕ 2›
obtain nx where edge:"c' ⊢ nx -CEdge (p',es',rets')→⇩p n'" and nx:"nx ⊕ 2 = n''"
by(rule Proc_CFG.cases,auto dest:label_incr_inj)
from IH[OF edge] nx show ?case by simp
next
case (Proc_CFG_WhileBodyExit c' n b)
from ‹c' ⊢ n -CEdge (p,es,rets)→⇩p Exit›
have False by(fastforce dest:Proc_CFG_Call_Labels)
thus ?case by simp
next
case Proc_CFG_Call
from ‹Call p es rets ⊢ n'' -CEdge (p',es',rets')→⇩p Label 1›
have "p = p' ∧ es = es' ∧ rets = rets' ∧ n'' = Label 0"
by(auto elim:Proc_CFG.cases)
then show ?case by simp
qed
lemma Proc_CFG_Call_targetnode_no_Call_sourcenode:
"⟦prog ⊢ n -CEdge (p,es,rets)→⇩p n'; prog ⊢ n' -CEdge (p',es',rets')→⇩p n''⟧
⟹ False"
proof(induct prog n "CEdge (p,es,rets)" n' arbitrary:n'' rule:Proc_CFG.induct)
case (Proc_CFG_SeqFirst c⇩1 n n' c⇩2)
note IH = ‹⋀n''. c⇩1 ⊢ n' -CEdge (p', es', rets')→⇩p n'' ⟹ False›
from ‹c⇩1;; c⇩2 ⊢ n' -CEdge (p',es',rets')→⇩p n''› ‹c⇩1 ⊢ n -CEdge (p,es,rets)→⇩p n'›
have "c⇩1 ⊢ n' -CEdge (p',es',rets')→⇩p n''"
apply - apply(erule Proc_CFG.cases,auto)
apply(fastforce dest:Proc_CFG_Call_Labels)
by(case_tac n)(auto dest:Proc_CFG_targetlabel_less_num_nodes)
then show ?case by (rule IH)
next
case (Proc_CFG_SeqConnect c⇩1 n c⇩2)
from ‹c⇩1 ⊢ n -CEdge (p,es,rets)→⇩p Exit› have False
by(fastforce dest:Proc_CFG_Call_Labels)
thus ?case by simp
next
case (Proc_CFG_SeqSecond c⇩2 n n' c⇩1)
note IH = ‹⋀n''. c⇩2 ⊢ n' -CEdge (p', es', rets')→⇩p n'' ⟹ False›
from ‹c⇩1;; c⇩2 ⊢ n' ⊕ #:c⇩1 -CEdge (p', es', rets')→⇩p n''› ‹c⇩2 ⊢ n -CEdge (p,es,rets)→⇩p n'›
obtain nx where "c⇩2 ⊢ n' -CEdge (p',es',rets')→⇩p nx"
apply - apply(erule Proc_CFG.cases,auto)
apply(cases n') apply(auto dest:Proc_CFG_sourcelabel_less_num_nodes)
apply(fastforce dest:Proc_CFG_Call_Labels)
by(cases n',auto,case_tac n,auto)
then show ?case by (rule IH)
next
case (Proc_CFG_CondThen c⇩1 n n' b c⇩2)
note IH = ‹⋀n''. c⇩1 ⊢ n' -CEdge (p',es',rets')→⇩p n'' ⟹ False›
from ‹if (b) c⇩1 else c⇩2 ⊢ n' ⊕ 1 -CEdge (p', es', rets')→⇩p n''› ‹c⇩1 ⊢ n -CEdge (p,es,rets)→⇩p n'›
obtain nx where "c⇩1 ⊢ n' -CEdge (p',es',rets')→⇩p nx"
apply - apply(erule Proc_CFG.cases,auto)
apply(cases n') apply auto apply(case_tac n) apply auto
apply(cases n') apply auto
by(case_tac n)(auto dest:Proc_CFG_targetlabel_less_num_nodes)
then show ?case by (rule IH)
next
case (Proc_CFG_CondElse c⇩2 n n' b c⇩1)
note IH = ‹⋀n''. c⇩2 ⊢ n' -CEdge (p',es',rets')→⇩p n'' ⟹ False›
from ‹if (b) c⇩1 else c⇩2 ⊢ n' ⊕ #:c⇩1 + 1 -CEdge (p', es', rets')→⇩p n''›
‹c⇩2 ⊢ n -CEdge (p,es,rets)→⇩p n'›
obtain nx where "c⇩2 ⊢ n' -CEdge (p',es',rets')→⇩p nx"
apply - apply(erule Proc_CFG.cases,auto)
apply(cases n') apply auto
apply(case_tac n) apply(auto dest:Proc_CFG_sourcelabel_less_num_nodes)
by(cases n',auto,case_tac n,auto)
then show ?case by (rule IH)
next
case (Proc_CFG_WhileBody c' n n' b)
note IH = ‹⋀n''. c' ⊢ n' -CEdge (p',es',rets')→⇩p n'' ⟹ False›
from ‹while (b) c' ⊢ n' ⊕ 2 -CEdge (p', es', rets')→⇩p n''› ‹c' ⊢ n -CEdge (p,es,rets)→⇩p n'›
obtain nx where "c' ⊢ n' -CEdge (p',es',rets')→⇩p nx"
apply - apply(erule Proc_CFG.cases,auto)
by(cases n',auto,case_tac n,auto)+
then show ?case by (rule IH)
next
case (Proc_CFG_WhileBodyExit c' n b)
from ‹c' ⊢ n -CEdge (p, es, rets)→⇩p Exit›
show ?case by(fastforce dest:Proc_CFG_Call_Labels)
next
case Proc_CFG_Call
from ‹Call p es rets ⊢ Label 1 -CEdge (p', es', rets')→⇩p n''›
show ?case by(fastforce elim:Proc_CFG.cases)
qed
lemma Proc_CFG_Call_follows_id_edge:
"⟦prog ⊢ n -CEdge (p,es,rets)→⇩p n'; prog ⊢ n' -IEdge et→⇩p n''⟧ ⟹ et = ⇑id"
proof(induct prog n "CEdge (p,es,rets)" n' arbitrary:n'' rule:Proc_CFG.induct)
case (Proc_CFG_SeqFirst c⇩1 n n' c⇩2)
note IH = ‹⋀n''. c⇩1 ⊢ n' -IEdge et→⇩p n'' ⟹ et = ⇑id›
from ‹c⇩1;;c⇩2 ⊢ n' -IEdge et→⇩p n''› ‹c⇩1 ⊢ n -CEdge (p,es,rets)→⇩p n'› ‹n' ≠ Exit›
obtain nx where "c⇩1 ⊢ n' -IEdge et→⇩p nx"
apply - apply(erule Proc_CFG.cases,auto)
by(case_tac n)(auto dest:Proc_CFG_targetlabel_less_num_nodes)
then show ?case by (rule IH)
next
case (Proc_CFG_SeqConnect c⇩1 n c⇩2)
from ‹c⇩1 ⊢ n -CEdge (p, es, rets)→⇩p Exit›
show ?case by(fastforce dest:Proc_CFG_Call_Labels)
next
case (Proc_CFG_SeqSecond c⇩2 n n' c⇩1)
note IH = ‹⋀n''. c⇩2 ⊢ n' -IEdge et→⇩p n'' ⟹ et = ⇑id›
from ‹c⇩1;;c⇩2 ⊢ n' ⊕ #:c⇩1 -IEdge et→⇩p n''› ‹c⇩2 ⊢ n -CEdge (p,es,rets)→⇩p n'›
obtain nx where "c⇩2 ⊢ n' -IEdge et→⇩p nx"
apply - apply(erule Proc_CFG.cases,auto)
apply(cases n') apply(auto dest:Proc_CFG_sourcelabel_less_num_nodes)
apply(cases n') apply(auto dest:Proc_CFG_sourcelabel_less_num_nodes)
by(cases n',auto,case_tac n,auto)
then show ?case by (rule IH)
next
case (Proc_CFG_CondThen c⇩1 n n' b c⇩2)
note IH = ‹⋀n''. c⇩1 ⊢ n' -IEdge et→⇩p n'' ⟹ et = ⇑id›
from ‹if (b) c⇩1 else c⇩2 ⊢ n' ⊕ 1 -IEdge et→⇩p n''› ‹c⇩1 ⊢ n -CEdge (p,es,rets)→⇩p n'›
‹n ≠ Entry›
obtain nx where "c⇩1 ⊢ n' -IEdge et→⇩p nx"
apply - apply(erule Proc_CFG.cases,auto)
apply(cases n') apply auto apply(case_tac n) apply auto
apply(cases n') apply auto
by(case_tac n)(auto dest:Proc_CFG_targetlabel_less_num_nodes)
then show ?case by (rule IH)
next
case (Proc_CFG_CondElse c⇩2 n n' b c⇩1)
note IH = ‹⋀n''. c⇩2 ⊢ n' -IEdge et→⇩p n'' ⟹ et = ⇑id›
from ‹if (b) c⇩1 else c⇩2 ⊢ n' ⊕ #:c⇩1 + 1 -IEdge et→⇩p n''› ‹c⇩2 ⊢ n -CEdge (p,es,rets)→⇩p n'›
obtain nx where "c⇩2 ⊢ n' -IEdge et→⇩p nx"
apply - apply(erule Proc_CFG.cases,auto)
apply(cases n') apply auto
apply(case_tac n) apply(auto dest:Proc_CFG_sourcelabel_less_num_nodes)
by(cases n',auto,case_tac n,auto)
then show ?case by (rule IH)
next
case (Proc_CFG_WhileBody c' n n' b)
note IH = ‹⋀n''. c' ⊢ n' -IEdge et→⇩p n'' ⟹ et = ⇑id›
from ‹while (b) c' ⊢ n' ⊕ 2 -IEdge et→⇩p n''› ‹c' ⊢ n -CEdge (p,es,rets)→⇩p n'›
obtain nx where "c' ⊢ n' -IEdge et→⇩p nx"
apply - apply(erule Proc_CFG.cases,auto)
apply(cases n') apply auto
apply(cases n') apply auto apply(case_tac n) apply auto
by(cases n',auto,case_tac n,auto)
then show ?case by (rule IH)
next
case (Proc_CFG_WhileBodyExit c' n et' b)
from ‹c' ⊢ n -CEdge (p, es, rets)→⇩p Exit›
show ?case by(fastforce dest:Proc_CFG_Call_Labels)
next
case Proc_CFG_Call
from ‹Call p es rets ⊢ Label 1 -IEdge et→⇩p n''› show ?case
by(fastforce elim:Proc_CFG.cases)
qed
lemma Proc_CFG_edge_det:
"⟦prog ⊢ n -et→⇩p n'; prog ⊢ n -et'→⇩p n'⟧ ⟹ et = et'"
proof(induct rule:Proc_CFG.induct)
case Proc_CFG_Entry_Exit thus ?case by(fastforce dest:Proc_CFG_EntryD)
next
case Proc_CFG_Entry thus ?case by(fastforce dest:Proc_CFG_EntryD)
next
case Proc_CFG_Skip thus ?case by(fastforce elim:Proc_CFG.cases)
next
case Proc_CFG_LAss thus ?case by(fastforce elim:Proc_CFG.cases)
next
case Proc_CFG_LAssSkip thus ?case by(fastforce elim:Proc_CFG.cases)
next
case (Proc_CFG_SeqFirst c⇩1 n et n' c⇩2)
note edge = ‹c⇩1 ⊢ n -et→⇩p n'›
note IH = ‹c⇩1 ⊢ n -et'→⇩p n' ⟹ et = et'›
from edge ‹n' ≠ Exit› obtain l where l:"n' = Label l" by (cases n') auto
with edge have "l < #:c⇩1" by(fastforce intro:Proc_CFG_targetlabel_less_num_nodes)
with ‹c⇩1;;c⇩2 ⊢ n -et'→⇩p n'› l have "c⇩1 ⊢ n -et'→⇩p n'"
by(fastforce elim:Proc_CFG.cases intro:Proc_CFG.intros dest:label_incr_ge)
from IH[OF this] show ?case .
next
case (Proc_CFG_SeqConnect c⇩1 n et c⇩2)
note edge = ‹c⇩1 ⊢ n -et→⇩p Exit›
note IH = ‹c⇩1 ⊢ n -et'→⇩p Exit ⟹ et = et'›
from edge ‹n ≠ Entry› obtain l where l:"n = Label l" by (cases n) auto
with edge have "l < #:c⇩1" by(fastforce intro: Proc_CFG_sourcelabel_less_num_nodes)
with ‹c⇩1;;c⇩2 ⊢ n -et'→⇩p Label #:c⇩1› l have "c⇩1 ⊢ n -et'→⇩p Exit"
by(fastforce elim:Proc_CFG.cases
dest:Proc_CFG_targetlabel_less_num_nodes label_incr_ge)
from IH[OF this] show ?case .
next
case (Proc_CFG_SeqSecond c⇩2 n et n' c⇩1)
note edge = ‹c⇩2 ⊢ n -et→⇩p n'›
note IH = ‹c⇩2 ⊢ n -et'→⇩p n' ⟹ et = et'›
from edge ‹n ≠ Entry› obtain l where l:"n = Label l" by (cases n) auto
with edge have "l < #:c⇩2" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
with ‹c⇩1;;c⇩2 ⊢ n ⊕ #:c⇩1 -et'→⇩p n' ⊕ #:c⇩1› l have "c⇩2 ⊢ n -et'→⇩p n'"
by -(erule Proc_CFG.cases,
(fastforce dest:Proc_CFG_sourcelabel_less_num_nodes label_incr_ge
dest!:label_incr_inj)+)
from IH[OF this] show ?case .
next
case Proc_CFG_CondTrue thus ?case by(fastforce elim:Proc_CFG.cases)
next
case Proc_CFG_CondFalse thus ?case by(fastforce elim:Proc_CFG.cases)
next
case (Proc_CFG_CondThen c⇩1 n et n' b c⇩2)
note edge = ‹c⇩1 ⊢ n -et→⇩p n'›
note IH = ‹c⇩1 ⊢ n -et'→⇩p n' ⟹ et = et'›
from edge ‹n ≠ Entry› obtain l where l:"n = Label l" by (cases n) auto
with edge have "l < #:c⇩1" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
with ‹if (b) c⇩1 else c⇩2 ⊢ n ⊕ 1 -et'→⇩p n' ⊕ 1› l have "c⇩1 ⊢ n -et'→⇩p n'"
by -(erule Proc_CFG.cases,(fastforce dest:label_incr_ge label_incr_inj)+)
from IH[OF this] show ?case .
next
case (Proc_CFG_CondElse c⇩2 n et n' b c⇩1)
note edge = ‹c⇩2 ⊢ n -et→⇩p n'›
note IH = ‹c⇩2 ⊢ n -et'→⇩p n' ⟹ et = et'›
from edge ‹n ≠ Entry› obtain l where l:"n = Label l" by (cases n) auto
with edge have "l < #:c⇩2" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
with ‹if (b) c⇩1 else c⇩2 ⊢ n ⊕ (#:c⇩1 + 1) -et'→⇩p n' ⊕ (#:c⇩1 + 1)› l
have "c⇩2 ⊢ n -et'→⇩p n'"
by -(erule Proc_CFG.cases,(fastforce dest:Proc_CFG_sourcelabel_less_num_nodes
label_incr_inj label_incr_ge label_incr_simp_rev)+)
from IH[OF this] show ?case .
next
case Proc_CFG_WhileTrue thus ?case by(fastforce elim:Proc_CFG.cases)
next
case Proc_CFG_WhileFalse thus ?case by(fastforce elim:Proc_CFG.cases)
next
case Proc_CFG_WhileFalseSkip thus ?case by(fastforce elim:Proc_CFG.cases)
next
case (Proc_CFG_WhileBody c' n et n' b)
note edge = ‹c' ⊢ n -et→⇩p n'›
note IH = ‹c' ⊢ n -et'→⇩p n' ⟹ et = et'›
from edge ‹n ≠ Entry› obtain l where l:"n = Label l" by (cases n) auto
with edge have less:"l < #:c'"
by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
from edge ‹n' ≠ Exit› obtain l' where l':"n' = Label l'" by (cases n') auto
with edge have "l' < #:c'" by(fastforce intro:Proc_CFG_targetlabel_less_num_nodes)
with ‹while (b) c' ⊢ n ⊕ 2 -et'→⇩p n' ⊕ 2› l less l' have "c' ⊢ n -et'→⇩p n'"
by(fastforce elim:Proc_CFG.cases dest:label_incr_start_Node_smaller)
from IH[OF this] show ?case .
next
case (Proc_CFG_WhileBodyExit c' n et b)
note edge = ‹c' ⊢ n -et→⇩p Exit›
note IH = ‹c' ⊢ n -et'→⇩p Exit ⟹ et = et'›
from edge ‹n ≠ Entry› obtain l where l:"n = Label l" by (cases n) auto
with edge have "l < #:c'" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
with ‹while (b) c' ⊢ n ⊕ 2 -et'→⇩p Label 0› l have "c' ⊢ n -et'→⇩p Exit"
by -(erule Proc_CFG.cases,auto dest:label_incr_start_Node_smaller)
from IH[OF this] show ?case .
next
case Proc_CFG_Call thus ?case by(fastforce elim:Proc_CFG.cases)
next
case Proc_CFG_CallSkip thus ?case by(fastforce elim:Proc_CFG.cases)
qed
lemma WCFG_deterministic:
"⟦prog ⊢ n⇩1 -et⇩1→⇩p n⇩1'; prog ⊢ n⇩2 -et⇩2→⇩p n⇩2'; n⇩1 = n⇩2; n⇩1' ≠ n⇩2'⟧
⟹ ∃Q Q'. et⇩1 = IEdge (Q)⇩√ ∧ et⇩2 = IEdge (Q')⇩√ ∧
(∀s. (Q s ⟶ ¬ Q' s) ∧ (Q' s ⟶ ¬ Q s))"
proof(induct arbitrary:n⇩2 n⇩2' rule:Proc_CFG.induct)
case (Proc_CFG_Entry_Exit prog)
from ‹prog ⊢ n⇩2 -et⇩2→⇩p n⇩2'› ‹Entry = n⇩2› ‹Exit ≠ n⇩2'›
have "et⇩2 = IEdge (λs. True)⇩√" by(fastforce dest:Proc_CFG_EntryD)
thus ?case by simp
next
case (Proc_CFG_Entry prog)
from ‹prog ⊢ n⇩2 -et⇩2→⇩p n⇩2'› ‹Entry = n⇩2› ‹Label 0 ≠ n⇩2'›
have "et⇩2 = IEdge (λs. False)⇩√" by(fastforce dest:Proc_CFG_EntryD)
thus ?case by simp
next
case Proc_CFG_Skip
from ‹Skip ⊢ n⇩2 -et⇩2→⇩p n⇩2'› ‹Label 0 = n⇩2› ‹Exit ≠ n⇩2'›
have False by(fastforce elim:Proc_CFG.cases)
thus ?case by simp
next
case (Proc_CFG_LAss V e)
from ‹V:=e ⊢ n⇩2 -et⇩2→⇩p n⇩2'› ‹Label 0 = n⇩2› ‹Label 1 ≠ n⇩2'›
have False by -(erule Proc_CFG.cases,auto)
thus ?case by simp
next
case (Proc_CFG_LAssSkip V e)
from ‹V:=e ⊢ n⇩2 -et⇩2→⇩p n⇩2'› ‹Label 1 = n⇩2› ‹Exit ≠ n⇩2'›
have False by -(erule Proc_CFG.cases,auto)
thus ?case by simp
next
case (Proc_CFG_SeqFirst c⇩1 n et n' c⇩2)
note IH = ‹⋀n⇩2 n⇩2'. ⟦c⇩1 ⊢ n⇩2 -et⇩2→⇩p n⇩2'; n = n⇩2; n' ≠ n⇩2'⟧
⟹ ∃Q Q'. et = IEdge (Q)⇩√ ∧ et⇩2 = IEdge (Q')⇩√ ∧
(∀s. (Q s ⟶ ¬ Q' s) ∧ (Q' s ⟶ ¬ Q s))›
from ‹c⇩1;;c⇩2 ⊢ n⇩2 -et⇩2→⇩p n⇩2'› ‹c⇩1 ⊢ n -et→⇩p n'› ‹n = n⇩2› ‹n' ≠ n⇩2'›
have "c⇩1 ⊢ n⇩2 -et⇩2→⇩p n⇩2' ∨ (c⇩1 ⊢ n⇩2 -et⇩2→⇩p Exit ∧ n⇩2' = Label #:c⇩1)"
apply hypsubst_thin apply(erule Proc_CFG.cases)
apply(auto intro:Proc_CFG.intros)
by(case_tac n,auto dest:Proc_CFG_sourcelabel_less_num_nodes)+
thus ?case
proof
assume "c⇩1 ⊢ n⇩2 -et⇩2→⇩p n⇩2'"
from IH[OF this ‹n = n⇩2› ‹n' ≠ n⇩2'›] show ?case .
next
assume "c⇩1 ⊢ n⇩2 -et⇩2→⇩p Exit ∧ n⇩2' = Label #:c⇩1"
hence edge:"c⇩1 ⊢ n⇩2 -et⇩2→⇩p Exit" and n2':"n⇩2' = Label #:c⇩1" by simp_all
from IH[OF edge ‹n = n⇩2› ‹n' ≠ Exit›] show ?case .
qed
next
case (Proc_CFG_SeqConnect c⇩1 n et c⇩2)
note IH = ‹⋀n⇩2 n⇩2'. ⟦c⇩1 ⊢ n⇩2 -et⇩2→⇩p n⇩2'; n = n⇩2; Exit ≠ n⇩2'⟧
⟹ ∃Q Q'. et = IEdge (Q)⇩√ ∧ et⇩2 = IEdge (Q')⇩√ ∧
(∀s. (Q s ⟶ ¬ Q' s) ∧ (Q' s ⟶ ¬ Q s))›
from ‹c⇩1;;c⇩2 ⊢ n⇩2 -et⇩2→⇩p n⇩2'› ‹c⇩1 ⊢ n -et→⇩p Exit› ‹n = n⇩2› ‹n ≠ Entry›
‹Label #:c⇩1 ≠ n⇩2'› have "c⇩1 ⊢ n⇩2 -et⇩2→⇩p n⇩2' ∧ Exit ≠ n⇩2'"
apply hypsubst_thin apply(erule Proc_CFG.cases)
apply(auto intro:Proc_CFG.intros)
by(case_tac n,auto dest:Proc_CFG_sourcelabel_less_num_nodes)+
from IH[OF this[THEN conjunct1] ‹n = n⇩2› this[THEN conjunct2]]
show ?case .
next
case (Proc_CFG_SeqSecond c⇩2 n et n' c⇩1)
note IH = ‹⋀n⇩2 n⇩2'. ⟦c⇩2 ⊢ n⇩2 -et⇩2→⇩p n⇩2'; n = n⇩2; n' ≠ n⇩2'⟧
⟹ ∃Q Q'. et = IEdge (Q)⇩√ ∧ et⇩2 = IEdge (Q')⇩√ ∧
(∀s. (Q s ⟶ ¬ Q' s) ∧ (Q' s ⟶ ¬ Q s))›
from ‹c⇩1;;c⇩2 ⊢ n⇩2 -et⇩2→⇩p n⇩2'› ‹c⇩2 ⊢ n -et→⇩p n'› ‹n ⊕ #:c⇩1 = n⇩2›
‹n' ⊕ #:c⇩1 ≠ n⇩2'› ‹n ≠ Entry›
obtain nx where "c⇩2 ⊢ n -et⇩2→⇩p nx ∧ nx ⊕ #:c⇩1 = n⇩2'"
apply - apply(erule Proc_CFG.cases)
apply(auto intro:Proc_CFG.intros)
apply(cases n,auto dest:Proc_CFG_sourcelabel_less_num_nodes)
apply(cases n,auto dest:Proc_CFG_sourcelabel_less_num_nodes)
by(fastforce dest:label_incr_inj)
with ‹n' ⊕ #:c⇩1 ≠ n⇩2'› have edge:"c⇩2 ⊢ n -et⇩2→⇩p nx" and neq:"n' ≠ nx"
by auto
from IH[OF edge _ neq] show ?case by simp
next
case (Proc_CFG_CondTrue b c⇩1 c⇩2)
from ‹if (b) c⇩1 else c⇩2 ⊢ n⇩2 -et⇩2→⇩p n⇩2'› ‹Label 0 = n⇩2› ‹Label 1 ≠ n⇩2'›
show ?case by -(erule Proc_CFG.cases,auto)
next
case (Proc_CFG_CondFalse b c⇩1 c⇩2)
from ‹if (b) c⇩1 else c⇩2 ⊢ n⇩2 -et⇩2→⇩p n⇩2'› ‹Label 0 = n⇩2› ‹Label (#:c⇩1 + 1) ≠ n⇩2'›
show ?case by -(erule Proc_CFG.cases,auto)
next
case (Proc_CFG_CondThen c⇩1 n et n' b c⇩2)
note IH = ‹⋀n⇩2 n⇩2'. ⟦c⇩1 ⊢ n⇩2 -et⇩2→⇩p n⇩2'; n = n⇩2; n' ≠ n⇩2'⟧
⟹ ∃Q Q'. et = IEdge (Q)⇩√ ∧ et⇩2 = IEdge (Q')⇩√ ∧
(∀s. (Q s ⟶ ¬ Q' s) ∧ (Q' s ⟶ ¬ Q s))›
from ‹if (b) c⇩1 else c⇩2 ⊢ n⇩2 -et⇩2→⇩p n⇩2'› ‹c⇩1 ⊢ n -et→⇩p n'› ‹n ≠ Entry›
‹n ⊕ 1 = n⇩2› ‹n' ⊕ 1 ≠ n⇩2'›
obtain nx where "c⇩1 ⊢ n -et⇩2→⇩p nx ∧ n' ≠ nx"
apply - apply(erule Proc_CFG.cases)
apply(auto intro:Proc_CFG.intros simp del:One_nat_def)
apply(drule label_incr_inj) apply(auto simp del:One_nat_def)
apply(drule label_incr_simp_rev[OF sym])
by(case_tac na,auto dest:Proc_CFG_sourcelabel_less_num_nodes)
from IH[OF this[THEN conjunct1] _ this[THEN conjunct2]] show ?case by simp
next
case (Proc_CFG_CondElse c⇩2 n et n' b c⇩1)
note IH = ‹⋀n⇩2 n⇩2'. ⟦c⇩2 ⊢ n⇩2 -et⇩2→⇩p n⇩2'; n = n⇩2; n' ≠ n⇩2'⟧
⟹ ∃Q Q'. et = IEdge (Q)⇩√ ∧ et⇩2 = IEdge (Q')⇩√ ∧
(∀s. (Q s ⟶ ¬ Q' s) ∧ (Q' s ⟶ ¬ Q s))›
from ‹if (b) c⇩1 else c⇩2 ⊢ n⇩2 -et⇩2→⇩p n⇩2'› ‹c⇩2 ⊢ n -et→⇩p n'› ‹n ≠ Entry›
‹n ⊕ #:c⇩1 + 1 = n⇩2› ‹n' ⊕ #:c⇩1 + 1 ≠ n⇩2'›
obtain nx where "c⇩2 ⊢ n -et⇩2→⇩p nx ∧ n' ≠ nx"
apply - apply(erule Proc_CFG.cases)
apply(auto intro:Proc_CFG.intros simp del:One_nat_def)
apply(drule label_incr_simp_rev)
apply(case_tac na,auto,cases n,auto dest:Proc_CFG_sourcelabel_less_num_nodes)
by(fastforce dest:label_incr_inj)
from IH[OF this[THEN conjunct1] _ this[THEN conjunct2]] show ?case by simp
next
case (Proc_CFG_WhileTrue b c')
from ‹while (b) c' ⊢ n⇩2 -et⇩2→⇩p n⇩2'› ‹Label 0 = n⇩2› ‹Label 2 ≠ n⇩2'›
show ?case by -(erule Proc_CFG.cases,auto)
next
case (Proc_CFG_WhileFalse b c')
from ‹while (b) c' ⊢ n⇩2 -et⇩2→⇩p n⇩2'› ‹Label 0 = n⇩2› ‹Label 1 ≠ n⇩2'›
show ?case by -(erule Proc_CFG.cases,auto)
next
case (Proc_CFG_WhileFalseSkip b c')
from ‹while (b) c' ⊢ n⇩2 -et⇩2→⇩p n⇩2'› ‹Label 1 = n⇩2› ‹Exit ≠ n⇩2'›
show ?case by -(erule Proc_CFG.cases,auto dest:label_incr_ge)
next
case (Proc_CFG_WhileBody c' n et n' b)
note IH = ‹⋀n⇩2 n⇩2'. ⟦c' ⊢ n⇩2 -et⇩2→⇩p n⇩2'; n = n⇩2; n' ≠ n⇩2'⟧
⟹ ∃Q Q'. et = IEdge (Q)⇩√ ∧ et⇩2 = IEdge (Q')⇩√ ∧
(∀s. (Q s ⟶ ¬ Q' s) ∧ (Q' s ⟶ ¬ Q s))›
from ‹while (b) c' ⊢ n⇩2 -et⇩2→⇩p n⇩2'› ‹c' ⊢ n -et→⇩p n'› ‹n ≠ Entry›
‹n' ≠ Exit› ‹n ⊕ 2 = n⇩2› ‹n' ⊕ 2 ≠ n⇩2'›
obtain nx where "c' ⊢ n -et⇩2→⇩p nx ∧ n' ≠ nx"
apply - apply(erule Proc_CFG.cases)
apply(auto intro:Proc_CFG.intros)
apply(fastforce dest:label_incr_ge[OF sym])
apply(fastforce dest:label_incr_inj)
by(fastforce dest:label_incr_inj)
from IH[OF this[THEN conjunct1] _ this[THEN conjunct2]] show ?case by simp
next
case (Proc_CFG_WhileBodyExit c' n et b)
note IH = ‹⋀n⇩2 n⇩2'. ⟦c' ⊢ n⇩2 -et⇩2→⇩p n⇩2'; n = n⇩2; Exit ≠ n⇩2'⟧
⟹ ∃Q Q'. et = IEdge (Q)⇩√ ∧ et⇩2 = IEdge (Q')⇩√ ∧
(∀s. (Q s ⟶ ¬ Q' s) ∧ (Q' s ⟶ ¬ Q s))›
from ‹while (b) c' ⊢ n⇩2 -et⇩2→⇩p n⇩2'› ‹c' ⊢ n -et→⇩p Exit› ‹n ≠ Entry›
‹n ⊕ 2 = n⇩2› ‹Label 0 ≠ n⇩2'›
obtain nx where "c' ⊢ n -et⇩2→⇩p nx ∧ Exit ≠ nx"
apply - apply(erule Proc_CFG.cases)
apply(auto intro:Proc_CFG.intros)
apply(fastforce dest:label_incr_ge[OF sym])
by(fastforce dest:label_incr_inj)
from IH[OF this[THEN conjunct1] _ this[THEN conjunct2]] show ?case by simp
next
case Proc_CFG_Call thus ?case by -(erule Proc_CFG.cases,auto)
next
case Proc_CFG_CallSkip thus ?case by -(erule Proc_CFG.cases,auto)
qed
subsection ‹And now: the interprocedural CFG›
subsubsection ‹Statements containing calls›
text ‹A procedure is a tuple composed of its name, its input and output variables
and its method body›
type_synonym proc = "(pname × vname list × vname list × cmd)"
type_synonym procs = "proc list"
text ‹‹containsCall› guarantees that a call to procedure p is in
a certain statement.›
declare conj_cong[fundef_cong]
function containsCall ::
"procs ⇒ cmd ⇒ pname list ⇒ pname ⇒ bool"
where "containsCall procs Skip ps p ⟷ False"
| "containsCall procs (V:=e) ps p ⟷ False"
| "containsCall procs (c⇩1;;c⇩2) ps p ⟷
containsCall procs c⇩1 ps p ∨ containsCall procs c⇩2 ps p"
| "containsCall procs (if (b) c⇩1 else c⇩2) ps p ⟷
containsCall procs c⇩1 ps p ∨ containsCall procs c⇩2 ps p"
| "containsCall procs (while (b) c) ps p ⟷
containsCall procs c ps p"
| "containsCall procs (Call q es' rets') ps p ⟷ p = q ∧ ps = [] ∨
(∃ins outs c ps'. ps = q#ps' ∧ (q,ins,outs,c) ∈ set procs ∧
containsCall procs c ps' p)"
by pat_completeness auto
termination containsCall
by(relation "measures [λ(procs,c,ps,p). length ps,
λ(procs,c,ps,p). size c]") auto
lemmas containsCall_induct[case_names Skip LAss Seq Cond While Call] =
containsCall.induct
lemma containsCallcases:
"containsCall procs prog ps p
⟹ ps = [] ∧ containsCall procs prog ps p ∨
(∃q ins outs c ps'. ps = ps'@[q] ∧ (q,ins,outs,c) ∈ set procs ∧
containsCall procs c [] p ∧ containsCall procs prog ps' q)"
proof(induct procs prog ps p rule:containsCall_induct)
case (Call procs q es' rets' ps p)
note IH = ‹⋀x y z ps'. ⟦ps = q#ps'; (q,x,y,z) ∈ set procs;
containsCall procs z ps' p⟧
⟹ ps' = [] ∧ containsCall procs z ps' p ∨
(∃qx ins outs c psx. ps' = psx@[qx] ∧ (qx,ins,outs,c) ∈ set procs ∧
containsCall procs c [] p ∧
containsCall procs z psx qx)›
from ‹containsCall procs (Call q es' rets') ps p›
have "p = q ∧ ps = [] ∨
(∃ins outs c ps'. ps = q#ps' ∧ (q,ins,outs,c) ∈ set procs ∧
containsCall procs c ps' p)" by simp
thus ?case
proof
assume assms:"p = q ∧ ps = []"
hence "containsCall procs (Call q es' rets') ps p" by simp
with assms show ?thesis by simp
next
assume "∃ins outs c ps'. ps = q#ps' ∧ (q,ins,outs,c) ∈ set procs ∧
containsCall procs c ps' p"
then obtain ins outs c ps' where "ps = q#ps'" and "(q,ins,outs,c) ∈ set procs"
and "containsCall procs c ps' p" by blast
from IH[OF this] have "ps' = [] ∧ containsCall procs c ps' p ∨
(∃qx insx outsx cx psx.
ps' = psx @ [qx] ∧ (qx,insx,outsx,cx) ∈ set procs ∧
containsCall procs cx [] p ∧ containsCall procs c psx qx)" .
thus ?thesis
proof
assume assms:"ps' = [] ∧ containsCall procs c ps' p"
have "containsCall procs (Call q es' rets') [] q" by simp
with assms ‹ps = q#ps'› ‹(q,ins,outs,c) ∈ set procs› show ?thesis by fastforce
next
assume "∃qx insx outsx cx psx.
ps' = psx@[qx] ∧ (qx,insx,outsx,cx) ∈ set procs ∧
containsCall procs cx [] p ∧ containsCall procs c psx qx"
then obtain qx insx outsx cx psx
where "ps' = psx@[qx]" and "(qx,insx,outsx,cx) ∈ set procs"
and "containsCall procs cx [] p"
and "containsCall procs c psx qx" by blast
from ‹(q,ins,outs,c) ∈ set procs› ‹containsCall procs c psx qx›
have "containsCall procs (Call q es' rets') (q#psx) qx" by fastforce
with ‹ps' = psx@[qx]› ‹ps = q#ps'› ‹(qx,insx,outsx,cx) ∈ set procs›
‹containsCall procs cx [] p› show ?thesis by fastforce
qed
qed
qed auto
lemma containsCallE:
"⟦containsCall procs prog ps p;
⟦ps = []; containsCall procs prog ps p⟧ ⟹ P procs prog ps p;
⋀q ins outs c es' rets' ps'. ⟦ps = ps'@[q]; (q,ins,outs,c) ∈ set procs;
containsCall procs c [] p; containsCall procs prog ps' q⟧
⟹ P procs prog ps p⟧ ⟹ P procs prog ps p"
by(auto dest:containsCallcases)
lemma containsCall_in_proc:
"⟦containsCall procs prog qs q; (q,ins,outs,c) ∈ set procs;
containsCall procs c [] p⟧
⟹ containsCall procs prog (qs@[q]) p"
proof(induct procs prog qs q rule:containsCall_induct)
case (Call procs qx esx retsx ps p')
note IH = ‹⋀x y z psx. ⟦ps = qx#psx; (qx,x,y,z) ∈ set procs;
containsCall procs z psx p'; (p',ins,outs,c) ∈ set procs;
containsCall procs c [] p⟧ ⟹ containsCall procs z (psx@[p']) p›
from ‹containsCall procs (Call qx esx retsx) ps p'›
have "p' = qx ∧ ps = [] ∨
(∃insx outsx cx psx. ps = qx#psx ∧ (qx,insx,outsx,cx) ∈ set procs ∧
containsCall procs cx psx p')" by simp
thus ?case
proof
assume assms:"p' = qx ∧ ps = []"
with ‹(p', ins, outs, c) ∈ set procs› ‹containsCall procs c [] p›
have "containsCall procs (Call qx esx retsx) [p'] p" by fastforce
with assms show ?thesis by simp
next
assume "∃insx outsx cx psx. ps = qx#psx ∧ (qx,insx,outsx,cx) ∈ set procs ∧
containsCall procs cx psx p'"
then obtain insx outsx cx psx where "ps = qx#psx"
and "(qx,insx,outsx,cx) ∈ set procs"
and "containsCall procs cx psx p'" by blast
from IH[OF this ‹(p', ins, outs, c) ∈ set procs›
‹containsCall procs c [] p›]
have "containsCall procs cx (psx @ [p']) p" .
with ‹ps = qx#psx› ‹(qx,insx,outsx,cx) ∈ set procs›
show ?thesis by fastforce
qed
qed auto
lemma containsCall_indirection:
"⟦containsCall procs prog qs q; containsCall procs c ps p;
(q,ins,outs,c) ∈ set procs⟧
⟹ containsCall procs prog (qs@q#ps) p"
proof(induct procs prog qs q rule:containsCall_induct)
case (Call procs px esx retsx ps' p')
note IH = ‹⋀x y z psx. ⟦ps' = px # psx; (px, x, y, z) ∈ set procs;
containsCall procs z psx p'; containsCall procs c ps p;
(p', ins, outs, c) ∈ set procs⟧
⟹ containsCall procs z (psx @ p' # ps) p›
from ‹containsCall procs (Call px esx retsx) ps' p'›
have "p' = px ∧ ps' = [] ∨
(∃insx outsx cx psx. ps' = px#psx ∧ (px,insx,outsx,cx) ∈ set procs ∧
containsCall procs cx psx p')" by simp
thus ?case
proof
assume "p' = px ∧ ps' = []"
with ‹containsCall procs c ps p› ‹(p', ins, outs, c) ∈ set procs›
show ?thesis by fastforce
next
assume "∃insx outsx cx psx. ps' = px#psx ∧ (px,insx,outsx,cx) ∈ set procs ∧
containsCall procs cx psx p'"
then obtain insx outsx cx psx where "ps' = px#psx"
and "(px,insx,outsx,cx) ∈ set procs"
and "containsCall procs cx psx p'" by blast
from IH[OF this ‹containsCall procs c ps p›
‹(p', ins, outs, c) ∈ set procs›]
have "containsCall procs cx (psx @ p' # ps) p" .
with ‹ps' = px#psx› ‹(px,insx,outsx,cx) ∈ set procs›
show ?thesis by fastforce
qed
qed auto
lemma Proc_CFG_Call_containsCall:
"prog ⊢ n -CEdge (p,es,rets)→⇩p n' ⟹ containsCall procs prog [] p"
by(induct prog n et≡"CEdge (p,es,rets)" n' rule:Proc_CFG.induct,auto)
lemma containsCall_empty_Proc_CFG_Call_edge:
assumes "containsCall procs prog [] p"
obtains l es rets l' where "prog ⊢ Label l -CEdge (p,es,rets)→⇩p Label l'"
proof(atomize_elim)
from ‹containsCall procs prog [] p›
show "∃l es rets l'. prog ⊢ Label l -CEdge (p,es,rets)→⇩p Label l'"
proof(induct procs prog ps≡"[]::pname list" p rule:containsCall_induct)
case Seq thus ?case
by auto(fastforce dest:Proc_CFG_SeqFirst,fastforce dest:Proc_CFG_SeqSecond)
next
case Cond thus ?case
by auto(fastforce dest:Proc_CFG_CondThen,fastforce dest:Proc_CFG_CondElse)
next
case While thus ?case by(fastforce dest:Proc_CFG_WhileBody)
next
case Call thus ?case by(fastforce intro:Proc_CFG_Call)
qed auto
qed
subsubsection‹The edges of the combined CFG›
type_synonym node = "(pname × label)"
type_synonym edge = "(node × (vname,val,node,pname) edge_kind × node)"
fun get_proc :: "node ⇒ pname"
where "get_proc (p,l) = p"
inductive PCFG ::
"cmd ⇒ procs ⇒ node ⇒ (vname,val,node,pname) edge_kind ⇒ node ⇒ bool"
("_,_ ⊢ _ -_→ _" [51,51,0,0,0] 81)
for prog::cmd and procs::procs
where
Main:
"prog ⊢ n -IEdge et→⇩p n' ⟹ prog,procs ⊢ (Main,n) -et→ (Main,n')"
| Proc:
"⟦(p,ins,outs,c) ∈ set procs; c ⊢ n -IEdge et→⇩p n';
containsCall procs prog ps p⟧
⟹ prog,procs ⊢ (p,n) -et→ (p,n')"
| MainCall:
"⟦prog ⊢ Label l -CEdge (p,es,rets)→⇩p n'; (p,ins,outs,c) ∈ set procs⟧
⟹ prog,procs ⊢ (Main,Label l)
-(λs. True):(Main,n')↪⇘p⇙map (λe cf. interpret e cf) es→ (p,Entry)"
| ProcCall:
"⟦(p,ins,outs,c) ∈ set procs; c ⊢ Label l -CEdge (p',es',rets')→⇩p Label l';
(p',ins',outs',c') ∈ set procs; containsCall procs prog ps p⟧
⟹ prog,procs ⊢ (p,Label l)
-(λs. True):(p,Label l')↪⇘p'⇙map (λe cf. interpret e cf) es'→ (p',Entry)"
| MainReturn:
"⟦prog ⊢ Label l -CEdge (p,es,rets)→⇩p Label l'; (p,ins,outs,c) ∈ set procs⟧
⟹ prog,procs ⊢ (p,Exit) -(λcf. snd cf = (Main,Label l'))↩⇘p⇙
(λcf cf'. cf'(rets [:=] map cf outs))→ (Main,Label l')"
| ProcReturn:
"⟦(p,ins,outs,c) ∈ set procs; c ⊢ Label l -CEdge (p',es',rets')→⇩p Label l';
(p',ins',outs',c') ∈ set procs; containsCall procs prog ps p⟧
⟹ prog,procs ⊢ (p',Exit) -(λcf. snd cf = (p,Label l'))↩⇘p'⇙
(λcf cf'. cf'(rets' [:=] map cf outs'))→ (p,Label l')"
| MainCallReturn:
"prog ⊢ n -CEdge (p,es,rets)→⇩p n'
⟹ prog,procs ⊢ (Main,n) -(λs. False)⇩√→ (Main,n')"
| ProcCallReturn:
"⟦(p,ins,outs,c) ∈ set procs; c ⊢ n -CEdge (p',es',rets')→⇩p n';
containsCall procs prog ps p⟧
⟹ prog,procs ⊢ (p,n) -(λs. False)⇩√→ (p,n')"
end
Theory WellFormProgs
section ‹Well-formedness of programs›
theory WellFormProgs imports PCFG begin
subsection ‹Well-formedness of procedure lists.›
definition wf_proc :: "proc ⇒ bool"
where "wf_proc x ≡ let (p,ins,outs,c) = x in
p ≠ Main ∧ distinct ins ∧ distinct outs"
definition well_formed :: "procs ⇒ bool"
where "well_formed procs ≡ distinct_fst procs ∧
(∀(p,ins,outs,c) ∈ set procs. wf_proc (p,ins,outs,c))"
lemma [dest]:"⟦well_formed procs; (Main,ins,outs,c) ∈ set procs⟧ ⟹ False"
by(fastforce simp:well_formed_def wf_proc_def)
lemma well_formed_same_procs [dest]:
"⟦well_formed procs; (p,ins,outs,c) ∈ set procs; (p,ins',outs',c') ∈ set procs⟧
⟹ ins = ins' ∧ outs = outs' ∧ c = c'"
apply(auto simp:well_formed_def distinct_fst_def distinct_map inj_on_def)
by(erule_tac x="(p,ins,outs,c)" in ballE,auto)+
lemma PCFG_sourcelabel_None_less_num_nodes:
"⟦prog,procs ⊢ (Main,Label l) -et→ n'; well_formed procs⟧ ⟹ l < #:prog"
proof(induct "(Main,Label l)" et n'
arbitrary:l rule:PCFG.induct)
case (Main et n')
from ‹prog ⊢ Label l -IEdge et→⇩p n'›
show ?case by(fastforce elim:Proc_CFG_sourcelabel_less_num_nodes)
next
case (MainCall l p es rets n' ins outs c)
from ‹prog ⊢ Label l -CEdge (p,es,rets)→⇩p n'›
show ?case by(fastforce elim:Proc_CFG_sourcelabel_less_num_nodes)
next
case (MainCallReturn p es rets n' l)
from ‹prog ⊢ Label l -CEdge (p, es, rets)→⇩p n'›
show ?case by(fastforce elim:Proc_CFG_sourcelabel_less_num_nodes)
qed auto
lemma Proc_CFG_sourcelabel_Some_less_num_nodes:
"⟦prog,procs ⊢ (p,Label l) -et→ n'; (p,ins,outs,c) ∈ set procs;
well_formed procs⟧ ⟹ l < #:c"
proof(induct "(p,Label l)" et n' arbitrary:l rule:PCFG.induct)
case (Proc ins' outs' c' et n')
from ‹c' ⊢ Label l -IEdge et→⇩p n'› have "l < #:c'"
by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
with ‹well_formed procs› ‹(p,ins,outs,c) ∈ set procs›
‹(p,ins',outs',c') ∈ set procs›
show ?case by fastforce
next
case (ProcCall ins' outs' c' l' p' es rets l'' ins'' outs'' c'' ps)
from ‹c' ⊢ Label l' -CEdge (p',es,rets)→⇩p Label l''› have "l' < #:c'"
by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
with ‹well_formed procs› ‹(p,ins,outs,c) ∈ set procs›
‹(p, ins', outs', c') ∈ set procs›
show ?case by fastforce
next
case (ProcCallReturn ins' outs' c' p' es rets n')
from ‹c' ⊢ Label l -CEdge (p', es, rets)→⇩p n'› have "l < #:c'"
by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
with ‹well_formed procs› ‹(p,ins,outs,c) ∈ set procs›
‹(p,ins',outs',c') ∈ set procs›
show ?case by fastforce
qed auto
lemma Proc_CFG_targetlabel_Main_less_num_nodes:
"⟦prog,procs ⊢ n -et→ (Main,Label l); well_formed procs⟧ ⟹ l < #:prog"
proof(induct n et "(Main,Label l)"
arbitrary:l rule:PCFG.induct)
case (Main n et)
from ‹prog ⊢ n -IEdge et→⇩p Label l›
show ?case by(fastforce elim:Proc_CFG_targetlabel_less_num_nodes)
next
case (MainReturn l' p es rets l'' ins outs c)
from ‹prog ⊢ Label l' -CEdge (p,es,rets)→⇩p Label l''›
show ?case by(fastforce elim:Proc_CFG_targetlabel_less_num_nodes)
next
case (MainCallReturn n p es rets)
from ‹prog ⊢ n -CEdge (p, es, rets)→⇩p Label l›
show ?case by(fastforce elim:Proc_CFG_targetlabel_less_num_nodes)
qed auto
lemma Proc_CFG_targetlabel_Some_less_num_nodes:
"⟦prog,procs ⊢ n -et→ (p,Label l); (p,ins,outs,c) ∈ set procs;
well_formed procs⟧ ⟹ l < #:c"
proof(induct n et "(p,Label l)" arbitrary:l rule:PCFG.induct)
case (Proc ins' outs' c' n et)
from ‹c' ⊢ n -IEdge et→⇩p Label l› have "l < #:c'"
by(fastforce intro:Proc_CFG_targetlabel_less_num_nodes)
with ‹well_formed procs› ‹(p,ins,outs,c) ∈ set procs›
‹(p,ins',outs',c') ∈ set procs›
show ?case by fastforce
next
case (ProcReturn ins' outs' c' l' p' es rets l ins'' outs'' c'' ps)
from ‹c' ⊢ Label l' -CEdge (p',es,rets)→⇩p Label l› have "l < #:c'"
by(fastforce intro:Proc_CFG_targetlabel_less_num_nodes)
with ‹well_formed procs› ‹(p,ins,outs,c) ∈ set procs›
‹(p, ins', outs', c') ∈ set procs›
show ?case by fastforce
next
case (ProcCallReturn ins' outs' c' n p'' es rets)
from ‹c' ⊢ n -CEdge (p'', es, rets)→⇩p Label l› have "l < #:c'"
by(fastforce intro:Proc_CFG_targetlabel_less_num_nodes)
with ‹well_formed procs› ‹(p,ins,outs,c) ∈ set procs›
‹(p,ins',outs',c') ∈ set procs›
show ?case by fastforce
qed auto
lemma Proc_CFG_edge_det:
"⟦prog,procs ⊢ n -et→ n'; prog,procs ⊢ n -et'→ n'; well_formed procs⟧
⟹ et = et'"
proof(induct rule:PCFG.induct)
case Main thus ?case by(auto elim:PCFG.cases dest:Proc_CFG_edge_det)
next
case Proc thus ?case by(auto elim:PCFG.cases dest:Proc_CFG_edge_det)
next
case (MainCall l p es rets n' ins outs c)
from ‹prog,procs ⊢ (Main,Label l) -et'→ (p,Entry)› ‹well_formed procs›
obtain es' rets' n'' ins' outs' c'
where "prog ⊢ Label l -CEdge (p,es',rets')→⇩p n''"
and "(p,ins',outs',c') ∈ set procs"
and "et' = (λs. True):(Main,n'')↪⇘p⇙map (λe cf. interpret e cf) es'"
by(auto elim:PCFG.cases)
from ‹(p,ins,outs,c) ∈ set procs› ‹(p,ins',outs',c') ∈ set procs›
‹well_formed procs›
have "ins = ins'" by fastforce
from ‹prog ⊢ Label l -CEdge (p,es,rets)→⇩p n'›
‹prog ⊢ Label l -CEdge (p,es',rets')→⇩p n''›
have "es = es'" and "n' = n''" by(auto dest:Proc_CFG_Call_nodes_eq)
with ‹et' = (λs. True):(Main,n'')↪⇘p⇙map (λe cf. interpret e cf) es'› ‹ins = ins'›
show ?case by simp
next
case (ProcCall p ins outs c l p' es' rets' l' ins' outs' c' ps)
from ‹prog,procs ⊢ (p,Label l) -et'→ (p',Entry)› ‹(p',ins',outs',c') ∈ set procs›
‹(p, ins, outs, c) ∈ set procs› ‹well_formed procs›
‹c ⊢ Label l -CEdge (p', es', rets')→⇩p Label l'›
show ?case
proof(induct "(p,Label l)" et' "(p',Entry)" rule:PCFG.induct)
case (ProcCall insx outsx cx es'x rets'x l'x ins'x outs'x c'x ps)
from ‹well_formed procs› ‹(p, insx, outsx, cx) ∈ set procs›
‹(p, ins, outs, c) ∈ set procs›
have [simp]:"cx = c" by auto
from ‹cx ⊢ Label l -CEdge (p', es'x, rets'x)→⇩p Label l'x›
‹c ⊢ Label l -CEdge (p', es', rets')→⇩p Label l'›
have [simp]:"es'x = es'" "l'x = l'" by(auto dest:Proc_CFG_Call_nodes_eq)
show ?case by simp
qed auto
next
case MainReturn
thus ?case by -(erule PCFG.cases,auto dest:Proc_CFG_Call_nodes_eq')
next
case (ProcReturn p ins outs c l p' es' rets' l' ins' outs' c' ps)
from ‹prog,procs ⊢ (p',Exit) -et'→ (p, Label l')›
‹(p, ins, outs, c) ∈ set procs› ‹(p', ins', outs', c') ∈ set procs›
‹c ⊢ Label l -CEdge (p', es', rets')→⇩p Label l'›
‹containsCall procs prog ps p› ‹well_formed procs›
show ?case
proof(induct "(p',Exit)" et' "(p,Label l')" rule:PCFG.induct)
case (ProcReturn insx outsx cx lx es'x rets'x ins'x outs'x c'x psx)
from ‹(p', ins'x, outs'x, c'x) ∈ set procs›
‹(p', ins', outs', c') ∈ set procs› ‹well_formed procs›
have [simp]:"outs'x = outs'" by fastforce
from ‹(p, insx, outsx, cx) ∈ set procs› ‹(p, ins, outs, c) ∈ set procs›
‹well_formed procs›
have [simp]:"cx = c" by auto
from ‹cx ⊢ Label lx -CEdge (p', es'x, rets'x)→⇩p Label l'›
‹c ⊢ Label l -CEdge (p', es', rets')→⇩p Label l'›
have [simp]:"rets'x = rets'" by(fastforce dest:Proc_CFG_Call_nodes_eq')
show ?case by simp
qed auto
next
case MainCallReturn thus ?case by(auto elim:PCFG.cases dest:Proc_CFG_edge_det)
next
case ProcCallReturn thus ?case by(auto elim:PCFG.cases dest:Proc_CFG_edge_det)
qed
lemma Proc_CFG_deterministic:
"⟦prog,procs ⊢ n⇩1 -et⇩1→ n⇩1'; prog,procs ⊢ n⇩2 -et⇩2→ n⇩2'; n⇩1 = n⇩2; n⇩1' ≠ n⇩2';
intra_kind et⇩1; intra_kind et⇩2; well_formed procs⟧
⟹ ∃Q Q'. et⇩1 = (Q)⇩√ ∧ et⇩2 = (Q')⇩√ ∧
(∀s. (Q s ⟶ ¬ Q' s) ∧ (Q' s ⟶ ¬ Q s))"
proof(induct arbitrary:n⇩2 n⇩2' rule:PCFG.induct)
case (Main n et n')
from ‹prog,procs ⊢ n⇩2 -et⇩2→ n⇩2'› ‹(Main,n) = n⇩2›
‹intra_kind et⇩2› ‹well_formed procs›
obtain m m' where "(Main,m) = n⇩2" and "(Main,m') = n⇩2'"
and disj:"prog ⊢ m -IEdge et⇩2→⇩p m' ∨
(∃p es rets. prog ⊢ m -CEdge (p,es,rets)→⇩p m' ∧ et⇩2 = (λs. False)⇩√)"
by(induct rule:PCFG.induct)(fastforce simp:intra_kind_def)+
from disj show ?case
proof
assume "prog ⊢ m -IEdge et⇩2→⇩p m'"
with ‹(Main,m) = n⇩2› ‹(Main,m') = n⇩2'›
‹prog ⊢ n -IEdge et→⇩p n'› ‹(Main,n) = n⇩2› ‹(Main,n') ≠ n⇩2'›
show ?thesis by(auto dest:WCFG_deterministic)
next
assume "∃p es rets. prog ⊢ m -CEdge (p, es, rets)→⇩p m' ∧ et⇩2 = (λs. False)⇩√"
with ‹(Main,m) = n⇩2› ‹(Main,m') = n⇩2'›
‹prog ⊢ n -IEdge et→⇩p n'› ‹(Main,n) = n⇩2› ‹(Main,n') ≠ n⇩2'›
have False by(fastforce dest:Proc_CFG_Call_Intra_edge_not_same_source)
thus ?thesis by simp
qed
next
case (Proc p ins outs c n et n')
from ‹prog,procs ⊢ n⇩2 -et⇩2→ n⇩2'› ‹(p,n) = n⇩2› ‹intra_kind et⇩2›
‹(p,ins,outs,c) ∈ set procs› ‹well_formed procs›
obtain m m' where "(p,m) = n⇩2" and "(p,m') = n⇩2'"
and disj:"c ⊢ m -IEdge et⇩2→⇩p m' ∨
(∃p' es' rets'. c ⊢ m -CEdge (p',es',rets')→⇩p m' ∧ et⇩2 = (λs. False)⇩√)"
by(induct rule:PCFG.induct)(fastforce simp:intra_kind_def)+
from disj show ?case
proof
assume "c ⊢ m -IEdge et⇩2→⇩p m'"
with ‹(p,m) = n⇩2› ‹(p,m') = n⇩2'›
‹c ⊢ n -IEdge et→⇩p n'› ‹(p,n) = n⇩2› ‹(p,n') ≠ n⇩2'›
show ?thesis by(auto dest:WCFG_deterministic)
next
assume "∃p' es' rets'. c ⊢ m -CEdge (p', es', rets')→⇩p m' ∧ et⇩2 = (λs. False)⇩√"
with ‹(p,m) = n⇩2› ‹(p,m') = n⇩2'›
‹c ⊢ n -IEdge et→⇩p n'› ‹(p,n) = n⇩2› ‹(p,n') ≠ n⇩2'›
have False by(fastforce dest:Proc_CFG_Call_Intra_edge_not_same_source)
thus ?thesis by simp
qed
next
case (MainCallReturn n p es rets n' n⇩2 n⇩2')
from ‹prog,procs ⊢ n⇩2 -et⇩2→ n⇩2'› ‹(Main,n) = n⇩2›
‹intra_kind et⇩2› ‹well_formed procs›
obtain m m' where "(Main,m) = n⇩2" and "(Main,m') = n⇩2'"
and disj:"prog ⊢ m -IEdge et⇩2→⇩p m' ∨
(∃p es rets. prog ⊢ m -CEdge (p,es,rets)→⇩p m' ∧ et⇩2 = (λs. False)⇩√)"
by(induct rule:PCFG.induct)(fastforce simp:intra_kind_def)+
from disj show ?case
proof
assume "prog ⊢ m -IEdge et⇩2→⇩p m'"
with ‹(Main,m) = n⇩2› ‹(Main,m') = n⇩2'› ‹prog ⊢ n -CEdge (p, es, rets)→⇩p n'›
‹(Main, n) = n⇩2› ‹(Main, n') ≠ n⇩2'›
have False by(fastforce dest:Proc_CFG_Call_Intra_edge_not_same_source)
thus ?thesis by simp
next
assume "∃p es rets. prog ⊢ m -CEdge (p,es,rets)→⇩p m' ∧ et⇩2 = (λs. False)⇩√"
with ‹(Main,m) = n⇩2› ‹(Main,m') = n⇩2'› ‹prog ⊢ n -CEdge (p, es, rets)→⇩p n'›
‹(Main, n) = n⇩2› ‹(Main, n') ≠ n⇩2'›
show ?thesis by(fastforce dest:Proc_CFG_Call_nodes_eq)
qed
next
case (ProcCallReturn p ins outs c n p' es rets n' ps n⇩2 n⇩2')
from ‹prog,procs ⊢ n⇩2 -et⇩2→ n⇩2'› ‹(p,n) = n⇩2› ‹intra_kind et⇩2›
‹(p,ins,outs,c) ∈ set procs› ‹well_formed procs›
obtain m m' where "(p,m) = n⇩2" and "(p,m') = n⇩2'"
and disj:"c ⊢ m -IEdge et⇩2→⇩p m' ∨
(∃p' es' rets'. c ⊢ m -CEdge (p',es',rets')→⇩p m' ∧ et⇩2 = (λs. False)⇩√)"
by(induct rule:PCFG.induct)(fastforce simp:intra_kind_def)+
from disj show ?case
proof
assume "c ⊢ m -IEdge et⇩2→⇩p m'"
with ‹(p,m) = n⇩2› ‹(p,m') = n⇩2'›
‹c ⊢ n -CEdge (p', es, rets)→⇩p n'› ‹(p,n) = n⇩2› ‹(p,n') ≠ n⇩2'›
have False by(fastforce dest:Proc_CFG_Call_Intra_edge_not_same_source)
thus ?thesis by simp
next
assume "∃p' es' rets'. c ⊢ m -CEdge (p', es', rets')→⇩p m' ∧ et⇩2 = (λs. False)⇩√"
with ‹(p,m) = n⇩2› ‹(p,m') = n⇩2'›
‹c ⊢ n -CEdge (p', es, rets)→⇩p n'› ‹(p,n) = n⇩2› ‹(p,n') ≠ n⇩2'›
show ?thesis by(fastforce dest:Proc_CFG_Call_nodes_eq)
qed
qed(auto simp:intra_kind_def)
subsection ‹Well-formedness of programs in combination with a procedure list.›
definition wf :: "cmd ⇒ procs ⇒ bool"
where "wf prog procs ≡ well_formed procs ∧
(∀ps p. containsCall procs prog ps p ⟶ (∃ins outs c. (p,ins,outs,c) ∈ set procs ∧
(∀c' n n' es rets. c' ⊢ n -CEdge (p,es,rets)→⇩p n' ⟶
distinct rets ∧ length rets = length outs ∧ length es = length ins)))"
lemma wf_well_formed [intro]:"wf prog procs ⟹ well_formed procs"
by(simp add:wf_def)
lemma wf_distinct_rets [intro]:
"⟦wf prog procs; containsCall procs prog ps p; (p,ins,outs,c) ∈ set procs;
c' ⊢ n -CEdge (p,es,rets)→⇩p n'⟧ ⟹ distinct rets"
by(fastforce simp:wf_def)
lemma
assumes "wf prog procs" and "containsCall procs prog ps p"
and "(p,ins,outs,c) ∈ set procs" and "c' ⊢ n -CEdge (p,es,rets)→⇩p n'"
shows wf_length_retsI [intro]:"length rets = length outs"
and wf_length_esI [intro]:"length es = length ins"
proof -
from ‹wf prog procs› have "well_formed procs" by fastforce
from assms
obtain ins' outs' c' where "(p,ins',outs',c') ∈ set procs"
and lengths:"length rets = length outs'" "length es = length ins'"
by(simp add:wf_def) blast
from ‹(p,ins,outs,c) ∈ set procs› ‹(p,ins',outs',c') ∈ set procs›
‹well_formed procs›
have "ins' = ins" "outs' = outs" "c' = c" by auto
with lengths show "length rets = length outs" "length es = length ins"
by simp_all
qed
subsection ‹Type of well-formed programs›
definition "wf_prog = {(prog,procs). wf prog procs}"
typedef wf_prog = wf_prog
unfolding wf_prog_def
apply (rule_tac x="(Skip,[])" in exI)
apply (simp add:wf_def well_formed_def)
done
lemma wf_wf_prog:"Rep_wf_prog wfp = (prog,procs) ⟹ wf prog procs"
using Rep_wf_prog[of wfp] by(simp add:wf_prog_def)
lemma wfp_Seq1: assumes "Rep_wf_prog wfp = (c⇩1;; c⇩2, procs)"
obtains wfp' where "Rep_wf_prog wfp' = (c⇩1, procs)"
using ‹Rep_wf_prog wfp = (c⇩1;; c⇩2, procs)›
apply(cases wfp) apply(auto simp:Abs_wf_prog_inverse wf_prog_def wf_def)
apply(erule_tac x="Abs_wf_prog (c⇩1, procs)" in meta_allE)
by(auto elim:meta_mp simp:Abs_wf_prog_inverse wf_prog_def wf_def)
lemma wfp_Seq2: assumes "Rep_wf_prog wfp = (c⇩1;; c⇩2, procs)"
obtains wfp' where "Rep_wf_prog wfp' = (c⇩2, procs)"
using ‹Rep_wf_prog wfp = (c⇩1;; c⇩2, procs)›
apply(cases wfp) apply(auto simp:Abs_wf_prog_inverse wf_prog_def wf_def)
apply(erule_tac x="Abs_wf_prog (c⇩2, procs)" in meta_allE)
by(auto elim:meta_mp simp:Abs_wf_prog_inverse wf_prog_def wf_def)
lemma wfp_CondTrue: assumes "Rep_wf_prog wfp = (if (b) c⇩1 else c⇩2, procs)"
obtains wfp' where "Rep_wf_prog wfp' = (c⇩1, procs)"
using ‹Rep_wf_prog wfp = (if (b) c⇩1 else c⇩2, procs)›
apply(cases wfp) apply(auto simp:Abs_wf_prog_inverse wf_prog_def wf_def)
apply(erule_tac x="Abs_wf_prog (c⇩1, procs)" in meta_allE)
by(auto elim:meta_mp simp:Abs_wf_prog_inverse wf_prog_def wf_def)
lemma wfp_CondFalse: assumes "Rep_wf_prog wfp = (if (b) c⇩1 else c⇩2, procs)"
obtains wfp' where "Rep_wf_prog wfp' = (c⇩2, procs)"
using ‹Rep_wf_prog wfp = (if (b) c⇩1 else c⇩2, procs)›
apply(cases wfp) apply(auto simp:Abs_wf_prog_inverse wf_prog_def wf_def)
apply(erule_tac x="Abs_wf_prog (c⇩2, procs)" in meta_allE)
by(auto elim:meta_mp simp:Abs_wf_prog_inverse wf_prog_def wf_def)
lemma wfp_WhileBody: assumes "Rep_wf_prog wfp = (while (b) c', procs)"
obtains wfp' where "Rep_wf_prog wfp' = (c', procs)"
using ‹Rep_wf_prog wfp = (while (b) c', procs)›
apply(cases wfp) apply(auto simp:Abs_wf_prog_inverse wf_prog_def wf_def)
apply(erule_tac x="Abs_wf_prog (c', procs)" in meta_allE)
by(auto elim:meta_mp simp:Abs_wf_prog_inverse wf_prog_def wf_def)
lemma wfp_Call: assumes "Rep_wf_prog wfp = (prog,procs)"
and "(p,ins,outs,c) ∈ set procs" and "containsCall procs prog ps p"
obtains wfp' where "Rep_wf_prog wfp' = (c,procs)"
using assms
apply(cases wfp) apply(auto simp:Abs_wf_prog_inverse wf_prog_def wf_def)
apply(erule_tac x="Abs_wf_prog (c, procs)" in meta_allE)
apply(erule meta_mp) apply(rule Abs_wf_prog_inverse)
by(auto dest:containsCall_indirection simp:wf_prog_def wf_def)
end
Theory Interpretation
section ‹Instantiate CFG locales with Proc CFG›
theory Interpretation imports WellFormProgs "../StaticInter/CFGExit" begin
subsection ‹Lifting of the basic definitions›
abbreviation sourcenode :: "edge ⇒ node"
where "sourcenode e ≡ fst e"
abbreviation targetnode :: "edge ⇒ node"
where "targetnode e ≡ snd(snd e)"
abbreviation kind :: "edge ⇒ (vname,val,node,pname) edge_kind"
where "kind e ≡ fst(snd e)"
definition valid_edge :: "wf_prog ⇒ edge ⇒ bool"
where "valid_edge wfp a ≡ let (prog,procs) = Rep_wf_prog wfp in
prog,procs ⊢ sourcenode a -kind a→ targetnode a"
definition get_return_edges :: "wf_prog ⇒ edge ⇒ edge set"
where "get_return_edges wfp a ≡
case kind a of Q:r↪⇘p⇙fs ⇒ {a'. valid_edge wfp a' ∧ (∃Q' f'. kind a' = Q'↩⇘p⇙f') ∧
targetnode a' = r}
| _ ⇒ {}"
lemma get_return_edges_non_call_empty:
"∀Q r p fs. kind a ≠ Q:r↪⇘p⇙fs ⟹ get_return_edges wfp a = {}"
by(cases "kind a",auto simp:get_return_edges_def)
lemma call_has_return_edge:
assumes "valid_edge wfp a" and "kind a = Q:r↪⇘p⇙fs"
obtains a' where "valid_edge wfp a'" and "∃Q' f'. kind a' = Q'↩⇘p⇙f'"
and "targetnode a' = r"
proof(atomize_elim)
from ‹valid_edge wfp a› ‹kind a = Q:r↪⇘p⇙fs›
obtain prog procs where "Rep_wf_prog wfp = (prog,procs)"
and "prog,procs ⊢ sourcenode a -Q:r↪⇘p⇙fs→ targetnode a"
by(fastforce simp:valid_edge_def)
from ‹prog,procs ⊢ sourcenode a -Q:r↪⇘p⇙fs→ targetnode a›
show "∃a'. valid_edge wfp a' ∧ (∃Q' f'. kind a' = Q'↩⇘p⇙f') ∧ targetnode a' = r"
proof(induct "sourcenode a" "Q:r↪⇘p⇙fs" "targetnode a" rule:PCFG.induct)
case (MainCall l es rets n' ins outs c)
from ‹prog ⊢ Label l -CEdge (p, es, rets)→⇩p n'› obtain l'
where [simp]:"n' = Label l'"
by(fastforce dest:Proc_CFG_Call_Labels)
from MainCall
have "prog,procs ⊢ (p,Exit) -(λcf. snd cf = (Main,Label l'))↩⇘p⇙
(λcf cf'. cf'(rets [:=] map cf outs))→ (Main,Label l')"
by(fastforce intro:MainReturn)
with ‹Rep_wf_prog wfp = (prog,procs)› ‹(Main, n') = r› show ?thesis
by(fastforce simp:valid_edge_def)
next
case (ProcCall px ins outs c l es' rets' l' ins' outs' c' ps)
from ProcCall have "prog,procs ⊢ (p,Exit) -(λcf. snd cf = (px,Label l'))↩⇘p⇙
(λcf cf'. cf'(rets' [:=] map cf outs'))→ (px,Label l')"
by(fastforce intro:ProcReturn)
with ‹Rep_wf_prog wfp = (prog,procs)› ‹(px, Label l') = r› show ?thesis
by(fastforce simp:valid_edge_def)
qed auto
qed
lemma get_return_edges_call_nonempty:
"⟦valid_edge wfp a; kind a = Q:r↪⇘p⇙fs⟧ ⟹ get_return_edges wfp a ≠ {}"
by -(erule call_has_return_edge,(fastforce simp:get_return_edges_def)+)
lemma only_return_edges_in_get_return_edges:
"⟦valid_edge wfp a; kind a = Q:r↪⇘p⇙fs; a' ∈ get_return_edges wfp a⟧
⟹ ∃Q' f'. kind a' = Q'↩⇘p⇙f'"
by(cases "kind a",auto simp:get_return_edges_def)
abbreviation lift_procs :: "wf_prog ⇒ (pname × vname list × vname list) list"
where "lift_procs wfp ≡ let (prog,procs) = Rep_wf_prog wfp in
map (λx. (fst x,fst(snd x),fst(snd(snd x)))) procs"
subsection ‹Instatiation of the ‹CFG› locale›
interpretation ProcCFG:
CFG sourcenode targetnode kind "valid_edge wfp" "(Main,Entry)"
get_proc "get_return_edges wfp" "lift_procs wfp" Main
for wfp
proof -
from Rep_wf_prog[of wfp]
obtain prog procs where [simp]:"Rep_wf_prog wfp = (prog,procs)"
by(fastforce simp:wf_prog_def)
hence wf:"well_formed procs" by(fastforce intro:wf_wf_prog)
show "CFG sourcenode targetnode kind (valid_edge wfp) (Main, Entry)
get_proc (get_return_edges wfp) (lift_procs wfp) Main"
proof
fix a assume "valid_edge wfp a" and "targetnode a = (Main, Entry)"
from this wf show False by(auto elim:PCFG.cases simp:valid_edge_def)
next
show "get_proc (Main, Entry) = Main" by simp
next
fix a Q r p fs
assume "valid_edge wfp a" and "kind a = Q:r↪⇘p⇙fs"
and "sourcenode a = (Main, Entry)"
thus False by(auto elim:PCFG.cases simp:valid_edge_def)
next
fix a a'
assume "valid_edge wfp a" and "valid_edge wfp a'"
and "sourcenode a = sourcenode a'" and "targetnode a = targetnode a'"
with wf show "a = a'"
by(cases a,cases a',auto dest:Proc_CFG_edge_det simp:valid_edge_def)
next
fix a Q r f
assume "valid_edge wfp a" and "kind a = Q:r↪⇘Main⇙f"
from this wf show False by(auto elim:PCFG.cases simp:valid_edge_def)
next
fix a Q' f'
assume "valid_edge wfp a" and "kind a = Q'↩⇘Main⇙f'"
from this wf show False by(auto elim:PCFG.cases simp:valid_edge_def)
next
fix a Q r p fs
assume "valid_edge wfp a" and "kind a = Q:r↪⇘p⇙fs"
thus "∃ins outs. (p, ins, outs) ∈ set (lift_procs wfp)"
apply(auto simp:valid_edge_def) apply(erule PCFG.cases) apply auto
apply(fastforce dest:Proc_CFG_IEdge_intra_kind simp:intra_kind_def)
apply(fastforce dest:Proc_CFG_IEdge_intra_kind simp:intra_kind_def)
apply(rule_tac x="ins" in exI) apply(rule_tac x="outs" in exI)
apply(rule_tac x="(p,ins,outs,c)" in image_eqI) apply auto
apply(rule_tac x="ins'" in exI) apply(rule_tac x="outs'" in exI)
apply(rule_tac x="(p,ins',outs',c')" in image_eqI) by(auto simp:set_conv_nth)
next
fix a assume "valid_edge wfp a" and "intra_kind (kind a)"
thus "get_proc (sourcenode a) = get_proc (targetnode a)"
by(auto elim:PCFG.cases simp:valid_edge_def intra_kind_def)
next
fix a Q r p fs
assume "valid_edge wfp a" and "kind a = Q:r↪⇘p⇙fs"
thus "get_proc (targetnode a) = p" by(auto elim:PCFG.cases simp:valid_edge_def)
next
fix a Q' p f'
assume "valid_edge wfp a" and "kind a = Q'↩⇘p⇙f'"
thus "get_proc (sourcenode a) = p" by(auto elim:PCFG.cases simp:valid_edge_def)
next
fix a Q r p fs
assume "valid_edge wfp a" and "kind a = Q:r↪⇘p⇙fs"
hence "prog,procs ⊢ sourcenode a -kind a→ targetnode a"
by(simp add:valid_edge_def)
from this ‹kind a = Q:r↪⇘p⇙fs›
show "∀a'. valid_edge wfp a' ∧ targetnode a' = targetnode a ⟶
(∃Qx rx fsx. kind a' = Qx:rx↪⇘p⇙fsx)"
proof(induct "sourcenode a" "kind a" "targetnode a" rule:PCFG.induct)
case (MainCall l p' es rets n' ins outs c)
from ‹λs. True:(Main, n')↪⇘p'⇙map interpret es = kind a› ‹kind a = Q:r↪⇘p⇙fs›
have [simp]:"p' = p" by simp
{ fix a' assume "valid_edge wfp a'" and "targetnode a' = (p', Entry)"
hence "∃Qx rx fsx. kind a' = Qx:rx↪⇘p⇙fsx"
by(auto elim:PCFG.cases simp:valid_edge_def) }
with ‹(p',Entry) = targetnode a› show ?case by simp
next
case (ProcCall px ins outs c l p' es rets l' ins' outs' c' ps)
from ‹λs. True:(px, Label l')↪⇘p'⇙map interpret es = kind a› ‹kind a = Q:r↪⇘p⇙fs›
have [simp]:"p' = p" by simp
{ fix a' assume "valid_edge wfp a'" and "targetnode a' = (p', Entry)"
hence "∃Qx rx fsx. kind a' = Qx:rx↪⇘p⇙fsx"
by(auto elim:PCFG.cases simp:valid_edge_def) }
with ‹(p', Entry) = targetnode a› show ?case by simp
qed auto
next
fix a Q' p f'
assume "valid_edge wfp a" and "kind a = Q'↩⇘p⇙f'"
hence "prog,procs ⊢ sourcenode a -kind a→ targetnode a"
by(simp add:valid_edge_def)
from this ‹kind a = Q'↩⇘p⇙f'›
show "∀a'. valid_edge wfp a' ∧ sourcenode a' = sourcenode a ⟶
(∃Qx fx. kind a' = Qx↩⇘p⇙fx)"
proof(induct "sourcenode a" "kind a" "targetnode a" rule:PCFG.induct)
case (MainReturn l p' es rets l' ins outs c)
from ‹λcf. snd cf = (Main, Label l')↩⇘p'⇙λcf cf'. cf'(rets [:=] map cf outs) =
kind a› ‹kind a = Q'↩⇘p⇙f'› have [simp]:"p' = p" by simp
{ fix a' assume "valid_edge wfp a'" and "sourcenode a' = (p', Exit)"
hence "∃Qx fx. kind a' = Qx↩⇘p⇙fx"
by(auto elim:PCFG.cases simp:valid_edge_def) }
with ‹(p', Exit) = sourcenode a› show ?case by simp
next
case (ProcReturn px ins outs c l p' es rets l' ins' outs' c' ps)
from ‹λcf. snd cf = (px, Label l')↩⇘p'⇙λcf cf'. cf'(rets [:=] map cf outs') =
kind a› ‹kind a = Q'↩⇘p⇙f'› have [simp]:"p' = p" by simp
{ fix a' assume "valid_edge wfp a'" and "sourcenode a' = (p', Exit)"
hence "∃Qx fx. kind a' = Qx↩⇘p⇙fx"
by(auto elim:PCFG.cases simp:valid_edge_def) }
with ‹(p', Exit) = sourcenode a› show ?case by simp
qed auto
next
fix a Q r p fs
assume "valid_edge wfp a" and "kind a = Q:r↪⇘p⇙fs"
thus "get_return_edges wfp a ≠ {}" by(rule get_return_edges_call_nonempty)
next
fix a a'
assume "valid_edge wfp a" and "a' ∈ get_return_edges wfp a"
thus "valid_edge wfp a'"
by(cases "kind a",auto simp:get_return_edges_def)
next
fix a a'
assume "valid_edge wfp a" and "a' ∈ get_return_edges wfp a"
thus "∃Q r p fs. kind a = Q:r↪⇘p⇙fs"
by(cases "kind a")(auto simp:get_return_edges_def)
next
fix a Q r p fs a'
assume "valid_edge wfp a" and "kind a = Q:r↪⇘p⇙fs"
and "a' ∈ get_return_edges wfp a"
thus "∃Q' f'. kind a' = Q'↩⇘p⇙f'" by(rule only_return_edges_in_get_return_edges)
next
fix a Q' p f'
assume "valid_edge wfp a" and "kind a = Q'↩⇘p⇙f'"
hence "prog,procs ⊢ sourcenode a -kind a→ targetnode a"
by(simp add:valid_edge_def)
from this ‹kind a = Q'↩⇘p⇙f'›
show "∃!a'. valid_edge wfp a' ∧ (∃Q r fs. kind a' = Q:r↪⇘p⇙fs) ∧
a ∈ get_return_edges wfp a'"
proof(induct "sourcenode a" "kind a" "targetnode a" rule:PCFG.induct)
case (MainReturn l px es rets l' ins outs c)
from ‹λcf. snd cf = (Main, Label l')↩⇘px⇙λcf cf'. cf'(rets [:=] map cf outs) =
kind a› ‹kind a = Q'↩⇘p⇙f'› have [simp]:"px = p" by simp
from ‹prog ⊢ Label l -CEdge (px, es, rets)→⇩p Label l'› have "l' = Suc l"
by(fastforce dest:Proc_CFG_Call_Labels)
from ‹prog ⊢ Label l -CEdge (px, es, rets)→⇩p Label l'›
have "containsCall procs prog [] px" by(rule Proc_CFG_Call_containsCall)
with ‹prog ⊢ Label l -CEdge (px, es, rets)→⇩p Label l'›
‹(px, ins, outs, c) ∈ set procs›
have "prog,procs ⊢ (p,Exit) -(λcf. snd cf = (Main,Label l'))↩⇘p⇙
(λcf cf'. cf'(rets [:=] map cf outs))→ (Main,Label l')"
by(fastforce intro:PCFG.MainReturn)
with ‹(px, Exit) = sourcenode a› ‹(Main, Label l') = targetnode a›
‹λcf. snd cf = (Main, Label l')↩⇘px⇙λcf cf'. cf'(rets [:=] map cf outs) =
kind a›
have edge:"prog,procs ⊢ sourcenode a -kind a→ targetnode a" by simp
from ‹prog ⊢ Label l -CEdge (px, es, rets)→⇩p Label l'›
‹(px, ins, outs, c) ∈ set procs›
have edge':"prog,procs ⊢ (Main,Label l)
-(λs. True):(Main,Label l')↪⇘p⇙map (λe cf. interpret e cf) es→ (p,Entry)"
by(fastforce intro:MainCall)
show ?case
proof(rule ex_ex1I)
from edge edge' ‹(Main, Label l') = targetnode a›
‹l' = Suc l› ‹kind a = Q'↩⇘p⇙f'›
show "∃a'. valid_edge wfp a' ∧
(∃Q r fs. kind a' = Q:r↪⇘p⇙fs) ∧ a ∈ get_return_edges wfp a'"
by(fastforce simp:valid_edge_def get_return_edges_def)
next
fix a' a''
assume "valid_edge wfp a' ∧
(∃Q r fs. kind a' = Q:r↪⇘p⇙fs) ∧ a ∈ get_return_edges wfp a'"
and "valid_edge wfp a'' ∧
(∃Q r fs. kind a'' = Q:r↪⇘p⇙fs) ∧ a ∈ get_return_edges wfp a''"
then obtain Q r fs Q' r' fs' where "valid_edge wfp a'"
and "kind a' = Q:r↪⇘p⇙fs" and "a ∈ get_return_edges wfp a'"
and "valid_edge wfp a''" and "kind a'' = Q':r'↪⇘p⇙fs'"
and "a ∈ get_return_edges wfp a''" by blast
from ‹valid_edge wfp a'› ‹kind a' = Q:r↪⇘p⇙fs›[THEN sym] edge wf ‹l' = Suc l›
‹a ∈ get_return_edges wfp a'› ‹(Main, Label l') = targetnode a›
have nodes:"sourcenode a' = (Main,Label l) ∧ targetnode a' = (p,Entry)"
apply(auto simp:valid_edge_def get_return_edges_def)
by(erule PCFG.cases,auto dest:Proc_CFG_Call_Labels)+
from ‹valid_edge wfp a''› ‹kind a'' = Q':r'↪⇘p⇙fs'›[THEN sym] ‹l' = Suc l›
‹a ∈ get_return_edges wfp a''› ‹(Main, Label l') = targetnode a› wf edge'
have nodes':"sourcenode a'' = (Main,Label l) ∧ targetnode a'' = (p,Entry)"
apply(auto simp:valid_edge_def get_return_edges_def)
by(erule PCFG.cases,auto dest:Proc_CFG_Call_Labels)+
with nodes ‹valid_edge wfp a'› ‹valid_edge wfp a''› wf
have "kind a' = kind a''"
by(fastforce dest:Proc_CFG_edge_det simp:valid_edge_def)
with nodes nodes' show "a' = a''" by(cases a',cases a'',auto)
qed
next
case (ProcReturn p' ins outs c l px esx retsx l' ins' outs' c' ps)
from ‹λcf. snd cf = (p', Label l')↩⇘px⇙λcf cf'. cf'(retsx [:=] map cf outs') =
kind a› ‹kind a = Q'↩⇘p⇙f'› have [simp]:"px = p" by simp
from ‹c ⊢ Label l -CEdge (px, esx, retsx)→⇩p Label l'› have "l' = Suc l"
by(fastforce dest:Proc_CFG_Call_Labels)
from ‹(p',ins,outs,c) ∈ set procs›
‹c ⊢ Label l -CEdge (px, esx, retsx)→⇩p Label l'›
‹(px, ins', outs', c') ∈ set procs› ‹containsCall procs prog ps p'›
have "prog,procs ⊢ (p,Exit) -(λcf. snd cf = (p',Label l'))↩⇘p⇙
(λcf cf'. cf'(retsx [:=] map cf outs'))→ (p',Label l')"
by(fastforce intro:PCFG.ProcReturn)
with ‹(px, Exit) = sourcenode a› ‹(p', Label l') = targetnode a›
‹λcf. snd cf = (p', Label l')↩⇘px⇙λcf cf'. cf'(retsx [:=] map cf outs') =
kind a› have edge:"prog,procs ⊢ sourcenode a -kind a→ targetnode a" by simp
from ‹(p',ins,outs,c) ∈ set procs›
‹c ⊢ Label l -CEdge (px, esx, retsx)→⇩p Label l'›
‹(px, ins', outs', c') ∈ set procs› ‹containsCall procs prog ps p'›
have edge':"prog,procs ⊢ (p',Label l)
-(λs. True):(p',Label l')↪⇘p⇙map (λe cf. interpret e cf) esx→ (p,Entry)"
by(fastforce intro:ProcCall)
show ?case
proof(rule ex_ex1I)
from edge edge' ‹(p', Label l') = targetnode a› ‹l' = Suc l›
‹(p', ins, outs, c) ∈ set procs› ‹kind a = Q'↩⇘p⇙f'›
show "∃a'. valid_edge wfp a' ∧
(∃Q r fs. kind a' = Q:r↪⇘p⇙fs) ∧ a ∈ get_return_edges wfp a'"
by(fastforce simp:valid_edge_def get_return_edges_def)
next
fix a' a''
assume "valid_edge wfp a' ∧
(∃Q r fs. kind a' = Q:r↪⇘p⇙fs) ∧ a ∈ get_return_edges wfp a'"
and "valid_edge wfp a'' ∧
(∃Q r fs. kind a'' = Q:r↪⇘p⇙fs) ∧ a ∈ get_return_edges wfp a''"
then obtain Q r fs Q' r' fs' where "valid_edge wfp a'"
and "kind a' = Q:r↪⇘p⇙fs" and "a ∈ get_return_edges wfp a'"
and "valid_edge wfp a''" and "kind a'' = Q':r'↪⇘p⇙fs'"
and "a ∈ get_return_edges wfp a''" by blast
from ‹valid_edge wfp a'› ‹kind a' = Q:r↪⇘p⇙fs›[THEN sym]
‹a ∈ get_return_edges wfp a'› edge ‹(p', Label l') = targetnode a› wf
‹(p', ins, outs, c) ∈ set procs› ‹l' = Suc l›
have nodes:"sourcenode a' = (p',Label l) ∧ targetnode a' = (p,Entry)"
apply(auto simp:valid_edge_def get_return_edges_def)
by(erule PCFG.cases,auto dest:Proc_CFG_Call_Labels)+
from ‹valid_edge wfp a''› ‹kind a'' = Q':r'↪⇘p⇙fs'›[THEN sym]
‹a ∈ get_return_edges wfp a''› edge ‹(p', Label l') = targetnode a› wf
‹(p', ins, outs, c) ∈ set procs› ‹l' = Suc l›
have nodes':"sourcenode a'' = (p',Label l) ∧ targetnode a'' = (p,Entry)"
apply(auto simp:valid_edge_def get_return_edges_def)
by(erule PCFG.cases,auto dest:Proc_CFG_Call_Labels)+
with nodes ‹valid_edge wfp a'› ‹valid_edge wfp a''› wf
have "kind a' = kind a''"
by(fastforce dest:Proc_CFG_edge_det simp:valid_edge_def)
with nodes nodes' show "a' = a''" by(cases a',cases a'',auto)
qed
qed auto
next
fix a a'
assume "valid_edge wfp a" and "a' ∈ get_return_edges wfp a"
then obtain Q r p fs l'
where "kind a = Q:r↪⇘p⇙fs" and "valid_edge wfp a'"
by(cases "kind a")(fastforce simp:valid_edge_def get_return_edges_def)+
from ‹valid_edge wfp a› ‹kind a = Q:r↪⇘p⇙fs› ‹a' ∈ get_return_edges wfp a›
obtain Q' f' where "kind a' = Q'↩⇘p⇙f'"
by(fastforce dest!:only_return_edges_in_get_return_edges)
with ‹valid_edge wfp a'› have "sourcenode a' = (p,Exit)"
by(auto elim:PCFG.cases simp:valid_edge_def)
from ‹valid_edge wfp a› ‹kind a = Q:r↪⇘p⇙fs›
have "prog,procs ⊢ sourcenode a -Q:r↪⇘p⇙fs→ targetnode a"
by(simp add:valid_edge_def)
thus "∃a''. valid_edge wfp a'' ∧ sourcenode a'' = targetnode a ∧
targetnode a'' = sourcenode a' ∧ kind a'' = (λcf. False)⇩√"
proof(induct "sourcenode a" "Q:r↪⇘p⇙fs" "targetnode a" rule:PCFG.induct)
case (MainCall l es rets n' ins outs c)
have "c ⊢ Entry -IEdge (λs. False)⇩√→⇩p Exit" by(rule Proc_CFG_Entry_Exit)
moreover
from ‹prog ⊢ Label l -CEdge (p, es, rets)→⇩p n'›
have "containsCall procs prog [] p" by(rule Proc_CFG_Call_containsCall)
ultimately have "prog,procs ⊢ (p,Entry) -(λs. False)⇩√→ (p,Exit)"
using ‹(p, ins, outs, c) ∈ set procs› by(fastforce intro:Proc)
with ‹sourcenode a' = (p,Exit)› ‹(p, Entry) = targetnode a›[THEN sym]
show ?case by(fastforce simp:valid_edge_def)
next
case (ProcCall px ins outs c l es' rets' l' ins' outs' c' ps)
have "c' ⊢ Entry -IEdge (λs. False)⇩√→⇩p Exit" by(rule Proc_CFG_Entry_Exit)
moreover
from ‹c ⊢ Label l -CEdge (p, es', rets')→⇩p Label l'›
have "containsCall procs c [] p" by(rule Proc_CFG_Call_containsCall)
with ‹containsCall procs prog ps px› ‹(px,ins,outs,c) ∈ set procs›
have "containsCall procs prog (ps@[px]) p"
by(rule containsCall_in_proc)
ultimately have "prog,procs ⊢ (p,Entry) -(λs. False)⇩√→ (p,Exit)"
using ‹(p, ins', outs', c') ∈ set procs› by(fastforce intro:Proc)
with ‹sourcenode a' = (p,Exit)› ‹(p, Entry) = targetnode a›[THEN sym]
show ?case by(fastforce simp:valid_edge_def)
qed auto
next
fix a a'
assume "valid_edge wfp a" and "a' ∈ get_return_edges wfp a"
then obtain Q r p fs l'
where "kind a = Q:r↪⇘p⇙fs" and "valid_edge wfp a'"
by(cases "kind a")(fastforce simp:valid_edge_def get_return_edges_def)+
from ‹valid_edge wfp a› ‹kind a = Q:r↪⇘p⇙fs› ‹a' ∈ get_return_edges wfp a›
obtain Q' f' where "kind a' = Q'↩⇘p⇙f'" and "targetnode a' = r"
by(auto simp:get_return_edges_def)
from ‹valid_edge wfp a› ‹kind a = Q:r↪⇘p⇙fs›
have "prog,procs ⊢ sourcenode a -Q:r↪⇘p⇙fs→ targetnode a"
by(simp add:valid_edge_def)
thus "∃a''. valid_edge wfp a'' ∧ sourcenode a'' = sourcenode a ∧
targetnode a'' = targetnode a' ∧ kind a'' = (λcf. False)⇩√"
proof(induct "sourcenode a" "Q:r↪⇘p⇙fs" "targetnode a" rule:PCFG.induct)
case (MainCall l es rets n' ins outs c)
from ‹prog ⊢ Label l -CEdge (p, es, rets)→⇩p n'›
have "prog,procs ⊢ (Main,Label l) -(λs. False)⇩√→ (Main,n')"
by(rule MainCallReturn)
with ‹(Main, Label l) = sourcenode a›[THEN sym] ‹targetnode a' = r›
‹(Main, n') = r›[THEN sym]
show ?case by(auto simp:valid_edge_def)
next
case (ProcCall px ins outs c l es' rets' l' ins' outs' c' ps)
from ‹(px,ins,outs,c) ∈ set procs› ‹containsCall procs prog ps px›
‹c ⊢ Label l -CEdge (p, es', rets')→⇩p Label l'›
have "prog,procs ⊢ (px,Label l) -(λs. False)⇩√→ (px,Label l')"
by(fastforce intro:ProcCallReturn)
with ‹(px, Label l) = sourcenode a›[THEN sym] ‹targetnode a' = r›
‹(px, Label l') = r›[THEN sym]
show ?case by(auto simp:valid_edge_def)
qed auto
next
fix a Q r p fs
assume "valid_edge wfp a" and "kind a = Q:r↪⇘p⇙fs"
hence "prog,procs ⊢ sourcenode a -kind a→ targetnode a"
by(simp add:valid_edge_def)
from this ‹kind a = Q:r↪⇘p⇙fs›
show "∃!a'. valid_edge wfp a' ∧
sourcenode a' = sourcenode a ∧ intra_kind (kind a')"
proof(induct "sourcenode a" "kind a" "targetnode a" rule:PCFG.induct)
case (MainCall l p' es rets n' ins outs c)
show ?thesis
proof(rule ex_ex1I)
from ‹prog ⊢ Label l -CEdge (p', es, rets)→⇩p n'›
have "prog,procs ⊢ (Main,Label l) -(λs. False)⇩√→ (Main,n')"
by(rule MainCallReturn)
with ‹(Main, Label l) = sourcenode a›[THEN sym]
show "∃a'. valid_edge wfp a' ∧
sourcenode a' = sourcenode a ∧ intra_kind (kind a')"
by(fastforce simp:valid_edge_def intra_kind_def)
next
fix a' a''
assume "valid_edge wfp a' ∧ sourcenode a' = sourcenode a ∧
intra_kind (kind a')" and "valid_edge wfp a'' ∧
sourcenode a'' = sourcenode a ∧ intra_kind (kind a'')"
hence "valid_edge wfp a'" and "sourcenode a' = sourcenode a"
and "intra_kind (kind a')" and "valid_edge wfp a''"
and "sourcenode a'' = sourcenode a" and "intra_kind (kind a'')" by simp_all
from ‹valid_edge wfp a'› ‹sourcenode a' = sourcenode a›
‹intra_kind (kind a')› ‹prog ⊢ Label l -CEdge (p', es, rets)→⇩p n'›
‹(Main, Label l) = sourcenode a› wf
have "targetnode a' = (Main,Label (Suc l))"
by(auto elim!:PCFG.cases dest:Proc_CFG_Call_Intra_edge_not_same_source
Proc_CFG_Call_Labels simp:intra_kind_def valid_edge_def)
from ‹valid_edge wfp a''› ‹sourcenode a'' = sourcenode a›
‹intra_kind (kind a'')› ‹prog ⊢ Label l -CEdge (p', es, rets)→⇩p n'›
‹(Main, Label l) = sourcenode a› wf
have "targetnode a'' = (Main,Label (Suc l))"
by(auto elim!:PCFG.cases dest:Proc_CFG_Call_Intra_edge_not_same_source
Proc_CFG_Call_Labels simp:intra_kind_def valid_edge_def)
with ‹valid_edge wfp a'› ‹sourcenode a' = sourcenode a›
‹valid_edge wfp a''› ‹sourcenode a'' = sourcenode a›
‹targetnode a' = (Main,Label (Suc l))› wf
show "a' = a''" by(cases a',cases a'')
(auto dest:Proc_CFG_edge_det simp:valid_edge_def)
qed
next
case (ProcCall px ins outs c l p' es' rets' l' ins' outs' c' ps)
show ?thesis
proof(rule ex_ex1I)
from ‹(px, ins, outs, c) ∈ set procs› ‹containsCall procs prog ps px›
‹c ⊢ Label l -CEdge (p', es', rets')→⇩p Label l'›
have "prog,procs ⊢ (px,Label l) -(λs. False)⇩√→ (px,Label l')"
by -(rule ProcCallReturn)
with ‹(px, Label l) = sourcenode a›[THEN sym]
show "∃a'. valid_edge wfp a' ∧ sourcenode a' = sourcenode a ∧
intra_kind (kind a')"
by(fastforce simp:valid_edge_def intra_kind_def)
next
fix a' a''
assume "valid_edge wfp a' ∧ sourcenode a' = sourcenode a ∧
intra_kind (kind a')" and "valid_edge wfp a'' ∧
sourcenode a'' = sourcenode a ∧ intra_kind (kind a'')"
hence "valid_edge wfp a'" and "sourcenode a' = sourcenode a"
and "intra_kind (kind a')" and "valid_edge wfp a''"
and "sourcenode a'' = sourcenode a" and "intra_kind (kind a'')" by simp_all
from ‹valid_edge wfp a'› ‹sourcenode a' = sourcenode a›
‹intra_kind (kind a')› ‹(px, ins, outs, c) ∈ set procs›
‹c ⊢ Label l -CEdge (p', es', rets')→⇩p Label l'›
‹(p', ins', outs', c') ∈ set procs› wf
‹containsCall procs prog ps px› ‹(px, Label l) = sourcenode a›
have "targetnode a' = (px,Label (Suc l))"
apply(auto simp:valid_edge_def) apply(erule PCFG.cases)
by(auto dest:Proc_CFG_Call_Intra_edge_not_same_source
Proc_CFG_Call_nodes_eq Proc_CFG_Call_Labels simp:intra_kind_def)
from ‹valid_edge wfp a''› ‹sourcenode a'' = sourcenode a›
‹intra_kind (kind a'')› ‹(px, ins, outs, c) ∈ set procs›
‹c ⊢ Label l -CEdge (p', es', rets')→⇩p Label l'›
‹(p', ins', outs', c') ∈ set procs› wf
‹containsCall procs prog ps px› ‹(px, Label l) = sourcenode a›
have "targetnode a'' = (px,Label (Suc l))"
apply(auto simp:valid_edge_def) apply(erule PCFG.cases)
by(auto dest:Proc_CFG_Call_Intra_edge_not_same_source
Proc_CFG_Call_nodes_eq Proc_CFG_Call_Labels simp:intra_kind_def)
with ‹valid_edge wfp a'› ‹sourcenode a' = sourcenode a›
‹valid_edge wfp a''› ‹sourcenode a'' = sourcenode a›
‹targetnode a' = (px,Label (Suc l))› wf
show "a' = a''" by(cases a',cases a'')
(auto dest:Proc_CFG_edge_det simp:valid_edge_def)
qed
qed auto
next
fix a Q' p f'
assume "valid_edge wfp a" and "kind a = Q'↩⇘p⇙f'"
hence "prog,procs ⊢ sourcenode a -kind a→ targetnode a"
by(simp add:valid_edge_def)
from this ‹kind a = Q'↩⇘p⇙f'›
show "∃!a'. valid_edge wfp a' ∧
targetnode a' = targetnode a ∧ intra_kind (kind a')"
proof(induct "sourcenode a" "kind a" "targetnode a" rule:PCFG.induct)
case (MainReturn l p' es rets l' ins outs c)
show ?thesis
proof(rule ex_ex1I)
from ‹prog ⊢ Label l -CEdge (p', es, rets)→⇩p Label l'›
have "prog,procs ⊢ (Main,Label l) -(λs. False)⇩√→
(Main,Label l')" by(rule MainCallReturn)
with ‹(Main, Label l') = targetnode a›[THEN sym]
show "∃a'. valid_edge wfp a' ∧
targetnode a' = targetnode a ∧ intra_kind (kind a')"
by(fastforce simp:valid_edge_def intra_kind_def)
next
fix a' a''
assume "valid_edge wfp a' ∧ targetnode a' = targetnode a ∧
intra_kind (kind a')" and "valid_edge wfp a'' ∧
targetnode a'' = targetnode a ∧ intra_kind (kind a'')"
hence "valid_edge wfp a'" and "targetnode a' = targetnode a"
and "intra_kind (kind a')" and "valid_edge wfp a''"
and "targetnode a'' = targetnode a" and "intra_kind (kind a'')" by simp_all
from ‹valid_edge wfp a'› ‹targetnode a' = targetnode a›
‹intra_kind (kind a')› ‹prog ⊢ Label l -CEdge (p', es, rets)→⇩p Label l'›
‹(Main, Label l') = targetnode a› wf
have "sourcenode a' = (Main,Label l)"
apply(auto elim!:PCFG.cases dest:Proc_CFG_Call_Intra_edge_not_same_target
simp:valid_edge_def intra_kind_def)
by(fastforce dest:Proc_CFG_Call_nodes_eq' Proc_CFG_Call_Labels)
from ‹valid_edge wfp a''› ‹targetnode a'' = targetnode a›
‹intra_kind (kind a'')› ‹prog ⊢ Label l -CEdge (p', es, rets)→⇩p Label l'›
‹(Main, Label l') = targetnode a› wf
have "sourcenode a'' = (Main,Label l)"
apply(auto elim!:PCFG.cases dest:Proc_CFG_Call_Intra_edge_not_same_target
simp:valid_edge_def intra_kind_def)
by(fastforce dest:Proc_CFG_Call_nodes_eq' Proc_CFG_Call_Labels)
with ‹valid_edge wfp a'› ‹targetnode a' = targetnode a›
‹valid_edge wfp a''› ‹targetnode a'' = targetnode a›
‹sourcenode a' = (Main,Label l)› wf
show "a' = a''" by(cases a',cases a'')
(auto dest:Proc_CFG_edge_det simp:valid_edge_def)
qed
next
case (ProcReturn px ins outs c l p' es' rets' l' ins' outs' c' ps)
show ?thesis
proof(rule ex_ex1I)
from ‹(px, ins, outs, c) ∈ set procs› ‹containsCall procs prog ps px›
‹c ⊢ Label l -CEdge (p', es', rets')→⇩p Label l'›
have "prog,procs ⊢ (px,Label l) -(λs. False)⇩√→ (px,Label l')"
by -(rule ProcCallReturn)
with ‹(px, Label l') = targetnode a›[THEN sym]
show "∃a'. valid_edge wfp a' ∧
targetnode a' = targetnode a ∧ intra_kind (kind a')"
by(fastforce simp:valid_edge_def intra_kind_def)
next
fix a' a''
assume "valid_edge wfp a' ∧ targetnode a' = targetnode a ∧
intra_kind (kind a')" and "valid_edge wfp a'' ∧
targetnode a'' = targetnode a ∧ intra_kind (kind a'')"
hence "valid_edge wfp a'" and "targetnode a' = targetnode a"
and "intra_kind (kind a')" and "valid_edge wfp a''"
and "targetnode a'' = targetnode a" and "intra_kind (kind a'')" by simp_all
from ‹valid_edge wfp a'› ‹targetnode a' = targetnode a›
‹intra_kind (kind a')› ‹(px, ins, outs, c) ∈ set procs›
‹(p', ins', outs', c') ∈ set procs› wf
‹c ⊢ Label l -CEdge (p', es', rets')→⇩p Label l'›
‹containsCall procs prog ps px› ‹(px, Label l') = targetnode a›
have "sourcenode a' = (px,Label l)"
apply(auto simp:valid_edge_def) apply(erule PCFG.cases)
by(auto dest:Proc_CFG_Call_Intra_edge_not_same_target
Proc_CFG_Call_nodes_eq' simp:intra_kind_def)
from ‹valid_edge wfp a''› ‹targetnode a'' = targetnode a›
‹intra_kind (kind a'')› ‹(px, ins, outs, c) ∈ set procs›
‹(p', ins', outs', c') ∈ set procs› wf
‹c ⊢ Label l -CEdge (p', es', rets')→⇩p Label l'›
‹containsCall procs prog ps px› ‹(px, Label l') = targetnode a›
have "sourcenode a'' = (px,Label l)"
apply(auto simp:valid_edge_def) apply(erule PCFG.cases)
by(auto dest:Proc_CFG_Call_Intra_edge_not_same_target
Proc_CFG_Call_nodes_eq' simp:intra_kind_def)
with ‹valid_edge wfp a'› ‹targetnode a' = targetnode a›
‹valid_edge wfp a''› ‹targetnode a'' = targetnode a›
‹sourcenode a' = (px,Label l)› wf
show "a' = a''" by(cases a',cases a'')
(auto dest:Proc_CFG_edge_det simp:valid_edge_def)
qed
qed auto
next
fix a a' Q⇩1 r⇩1 p fs⇩1 Q⇩2 r⇩2 fs⇩2
assume "valid_edge wfp a" and "valid_edge wfp a'"
and "kind a = Q⇩1:r⇩1↪⇘p⇙fs⇩1" and "kind a' = Q⇩2:r⇩2↪⇘p⇙fs⇩2"
thus "targetnode a = targetnode a'" by(auto elim!:PCFG.cases simp:valid_edge_def)
next
from wf show "distinct_fst (lift_procs wfp)"
by(fastforce simp:well_formed_def distinct_fst_def o_def)
next
fix p ins outs assume "(p, ins, outs) ∈ set (lift_procs wfp)"
from ‹(p, ins, outs) ∈ set (lift_procs wfp)› wf
show "distinct ins" by(fastforce simp:well_formed_def wf_proc_def)
next
fix p ins outs assume "(p, ins, outs) ∈ set (lift_procs wfp)"
from ‹(p, ins, outs) ∈ set (lift_procs wfp)› wf
show "distinct outs" by(fastforce simp:well_formed_def wf_proc_def)
qed
qed
subsection ‹Instatiation of the ‹CFGExit› locale›
interpretation ProcCFGExit:
CFGExit sourcenode targetnode kind "valid_edge wfp" "(Main,Entry)"
get_proc "get_return_edges wfp" "lift_procs wfp" Main "(Main,Exit)"
for wfp
proof -
from Rep_wf_prog[of wfp]
obtain prog procs where [simp]:"Rep_wf_prog wfp = (prog,procs)"
by(fastforce simp:wf_prog_def)
hence wf:"well_formed procs" by(fastforce intro:wf_wf_prog)
show "CFGExit sourcenode targetnode kind (valid_edge wfp) (Main, Entry)
get_proc (get_return_edges wfp) (lift_procs wfp) Main (Main, Exit)"
proof
fix a assume "valid_edge wfp a" and "sourcenode a = (Main, Exit)"
with wf show False by(auto elim:PCFG.cases simp:valid_edge_def)
next
show "get_proc (Main, Exit) = Main" by simp
next
fix a Q p f
assume "valid_edge wfp a" and "kind a = Q↩⇘p⇙f"
and "targetnode a = (Main, Exit)"
thus False by(auto elim:PCFG.cases simp:valid_edge_def)
next
have "prog,procs ⊢ (Main,Entry) -(λs. False)⇩√→ (Main,Exit)"
by(fastforce intro:Main Proc_CFG_Entry_Exit)
thus "∃a. valid_edge wfp a ∧
sourcenode a = (Main, Entry) ∧
targetnode a = (Main, Exit) ∧ kind a = (λs. False)⇩√"
by(fastforce simp:valid_edge_def)
qed
qed
end
Theory Labels
section ‹Labels›
theory Labels imports Com begin
text ‹Labels describe a mapping from the inner node label
to the matching command›
inductive labels :: "cmd ⇒ nat ⇒ cmd ⇒ bool"
where
Labels_Base:
"labels c 0 c"
| Labels_LAss:
"labels (V:=e) 1 Skip"
| Labels_Seq1:
"labels c⇩1 l c ⟹ labels (c⇩1;;c⇩2) l (c;;c⇩2)"
| Labels_Seq2:
"labels c⇩2 l c ⟹ labels (c⇩1;;c⇩2) (l + #:c⇩1) c"
| Labels_CondTrue:
"labels c⇩1 l c ⟹ labels (if (b) c⇩1 else c⇩2) (l + 1) c"
| Labels_CondFalse:
"labels c⇩2 l c ⟹ labels (if (b) c⇩1 else c⇩2) (l + #:c⇩1 + 1) c"
| Labels_WhileBody:
"labels c' l c ⟹ labels (while(b) c') (l + 2) (c;;while(b) c')"
| Labels_WhileExit:
"labels (while(b) c') 1 Skip"
| Labels_Call:
"labels (Call p es rets) 1 Skip"
lemma label_less_num_inner_nodes:
"labels c l c' ⟹ l < #:c"
proof(induct c arbitrary:l c')
case Skip
from ‹labels Skip l c'› show ?case by(fastforce elim:labels.cases)
next
case (LAss V e)
from ‹labels (V:=e) l c'› show ?case by(fastforce elim:labels.cases)
next
case (Seq c⇩1 c⇩2)
note IH1 = ‹⋀l c'. labels c⇩1 l c' ⟹ l < #:c⇩1›
note IH2 = ‹⋀l c'. labels c⇩2 l c' ⟹ l < #:c⇩2›
from ‹labels (c⇩1;;c⇩2) l c'› IH1 IH2 show ?case
by simp(erule labels.cases,auto,force)
next
case (Cond b c⇩1 c⇩2)
note IH1 = ‹⋀l c'. labels c⇩1 l c' ⟹ l < #:c⇩1›
note IH2 = ‹⋀l c'. labels c⇩2 l c' ⟹ l < #:c⇩2›
from ‹labels (if (b) c⇩1 else c⇩2) l c'› IH1 IH2 show ?case
by simp(erule labels.cases,auto,force)
next
case (While b c)
note IH = ‹⋀l c'. labels c l c' ⟹ l < #:c›
from ‹labels (while (b) c) l c'› IH show ?case
by simp(erule labels.cases,fastforce+)
next
case (Call p es rets)
thus ?case by simp(erule labels.cases,fastforce+)
qed
declare One_nat_def [simp del]
lemma less_num_inner_nodes_label:
assumes "l < #:c" obtains c' where "labels c l c'"
proof(atomize_elim)
from ‹l < #:c› show "∃c'. labels c l c'"
proof(induct c arbitrary:l)
case Skip
from ‹l < #:Skip› have "l = 0" by simp
thus ?case by(fastforce intro:Labels_Base)
next
case (LAss V e)
from ‹l < #:(V:=e)› have "l = 0 ∨ l = 1" by auto
thus ?case by(auto intro:Labels_Base Labels_LAss)
next
case (Seq c⇩1 c⇩2)
note IH1 = ‹⋀l. l < #:c⇩1 ⟹ ∃c'. labels c⇩1 l c'›
note IH2 = ‹⋀l. l < #:c⇩2 ⟹ ∃c'. labels c⇩2 l c'›
show ?case
proof(cases "l < #:c⇩1")
case True
from IH1[OF this] obtain c' where "labels c⇩1 l c'" by auto
hence "labels (c⇩1;;c⇩2) l (c';;c⇩2)" by(fastforce intro:Labels_Seq1)
thus ?thesis by auto
next
case False
hence "#:c⇩1 ≤ l" by simp
then obtain l' where "l = l' + #:c⇩1" and "l' = l - #:c⇩1" by simp
from ‹l = l' + #:c⇩1› ‹l < #:c⇩1;;c⇩2› have "l' < #:c⇩2" by simp
from IH2[OF this] obtain c' where "labels c⇩2 l' c'" by auto
with ‹l = l' + #:c⇩1› have "labels (c⇩1;;c⇩2) l c'"
by(fastforce intro:Labels_Seq2)
thus ?thesis by auto
qed
next
case (Cond b c⇩1 c⇩2)
note IH1 = ‹⋀l. l < #:c⇩1 ⟹ ∃c'. labels c⇩1 l c'›
note IH2 = ‹⋀l. l < #:c⇩2 ⟹ ∃c'. labels c⇩2 l c'›
show ?case
proof(cases "l = 0")
case True
thus ?thesis by(fastforce intro:Labels_Base)
next
case False
hence "0 < l" by simp
then obtain l' where "l = l' + 1" and "l' = l - 1" by simp
thus ?thesis
proof(cases "l' < #:c⇩1")
case True
from IH1[OF this] obtain c' where "labels c⇩1 l' c'" by auto
with ‹l = l' + 1› have "labels (if (b) c⇩1 else c⇩2) l c'"
by(fastforce dest:Labels_CondTrue)
thus ?thesis by auto
next
case False
hence "#:c⇩1 ≤ l'" by simp
then obtain l'' where "l' = l'' + #:c⇩1" and "l'' = l' - #:c⇩1" by simp
from ‹l' = l'' + #:c⇩1› ‹l = l' + 1› ‹l < #:if (b) c⇩1 else c⇩2›
have "l'' < #:c⇩2" by simp
from IH2[OF this] obtain c' where "labels c⇩2 l'' c'" by auto
with ‹l' = l'' + #:c⇩1› ‹l = l' + 1› have "labels (if (b) c⇩1 else c⇩2) l c'"
by(fastforce dest:Labels_CondFalse)
thus ?thesis by auto
qed
qed
next
case (While b c')
note IH = ‹⋀l. l < #:c' ⟹ ∃c''. labels c' l c''›
show ?case
proof(cases "l < 1")
case True
hence "l = 0" by simp
thus ?thesis by(fastforce intro:Labels_Base)
next
case False
show ?thesis
proof(cases "l < 2")
case True
with ‹¬ l < 1› have "l = 1" by simp
thus ?thesis by(fastforce intro:Labels_WhileExit)
next
case False
with ‹¬ l < 1› have "2 ≤ l" by simp
then obtain l' where "l = l' + 2" and "l' = l - 2"
by(simp del:add_2_eq_Suc')
from ‹l = l' + 2› ‹l < #:while (b) c'› have "l' < #:c'" by simp
from IH[OF this] obtain c'' where "labels c' l' c''" by auto
with ‹l = l' + 2› have "labels (while (b) c') l (c'';;while (b) c')"
by(fastforce dest:Labels_WhileBody)
thus ?thesis by auto
qed
qed
next
case (Call p es rets)
show ?case
proof(cases "l < 1")
case True
hence "l = 0" by simp
thus ?thesis by(fastforce intro:Labels_Base)
next
case False
with ‹l < #:Call p es rets› have "l = 1" by simp
thus ?thesis by(fastforce intro:Labels_Call)
qed
qed
qed
lemma labels_det:
"labels c l c'⟹ (⋀c''. labels c l c''⟹ c' = c'')"
proof(induct rule:labels.induct)
case (Labels_Base c c'')
from ‹labels c 0 c''› obtain l where "labels c l c''" and "l = 0" by auto
thus ?case by(induct rule:labels.induct,auto)
next
case (Labels_Seq1 c⇩1 l c c⇩2)
note IH = ‹⋀c''. labels c⇩1 l c'' ⟹ c = c''›
from ‹labels c⇩1 l c› have "l < #:c⇩1" by(fastforce intro:label_less_num_inner_nodes)
with ‹labels (c⇩1;;c⇩2) l c''› obtain cx where "c'' = cx;;c⇩2 ∧ labels c⇩1 l cx"
by(fastforce elim:labels.cases intro:Labels_Base)
hence [simp]:"c'' = cx;;c⇩2" and "labels c⇩1 l cx" by simp_all
from IH[OF ‹labels c⇩1 l cx›] show ?case by simp
next
case (Labels_Seq2 c⇩2 l c c⇩1)
note IH = ‹⋀c''. labels c⇩2 l c'' ⟹ c = c''›
from ‹labels (c⇩1;;c⇩2) (l + #:c⇩1) c''› ‹labels c⇩2 l c› have "labels c⇩2 l c''"
by(auto elim:labels.cases dest:label_less_num_inner_nodes)
from IH[OF this] show ?case .
next
case (Labels_CondTrue c⇩1 l c b c⇩2)
note IH = ‹⋀c''. labels c⇩1 l c'' ⟹ c = c''›
from ‹labels (if (b) c⇩1 else c⇩2) (l + 1) c''› ‹labels c⇩1 l c› have "labels c⇩1 l c''"
by(fastforce elim:labels.cases dest:label_less_num_inner_nodes)
from IH[OF this] show ?case .
next
case (Labels_CondFalse c⇩2 l c b c⇩1)
note IH = ‹⋀c''. labels c⇩2 l c'' ⟹ c = c''›
from ‹labels (if (b) c⇩1 else c⇩2) (l + #:c⇩1 + 1) c''› ‹labels c⇩2 l c›
have "labels c⇩2 l c''"
by(fastforce elim:labels.cases dest:label_less_num_inner_nodes)
from IH[OF this] show ?case .
next
case (Labels_WhileBody c' l c b)
note IH = ‹⋀c''. labels c' l c'' ⟹ c = c''›
from ‹labels (while (b) c') (l + 2) c''› ‹labels c' l c›
obtain cx where "c'' = cx;;while (b) c' ∧ labels c' l cx"
by -(erule labels.cases,auto)
hence [simp]:"c'' = cx;;while (b) c'" and "labels c' l cx" by simp_all
from IH[OF ‹labels c' l cx›] show ?case by simp
qed (fastforce elim:labels.cases)+
definition label :: "cmd ⇒ nat ⇒ cmd"
where "label c n ≡ (THE c'. labels c n c')"
lemma labels_THE:
"labels c l c' ⟹ (THE c'. labels c l c') = c'"
by(fastforce intro:the_equality dest:labels_det)
lemma labels_label:"labels c l c' ⟹ label c l = c'"
by(fastforce intro:labels_THE simp:label_def)
end
Theory WellFormed
section ‹Instantiate well-formedness locales with Proc CFG›
theory WellFormed imports Interpretation Labels "../StaticInter/CFGExit_wf" begin
subsection ‹Determining the first atomic command›
fun fst_cmd :: "cmd ⇒ cmd"
where "fst_cmd (c⇩1;;c⇩2) = fst_cmd c⇩1"
| "fst_cmd c = c"
lemma Proc_CFG_Call_target_fst_cmd_Skip:
"⟦labels prog l' c; prog ⊢ n -CEdge (p,es,rets)→⇩p Label l'⟧
⟹ fst_cmd c = Skip"
proof(induct arbitrary:n rule:labels.induct)
case (Labels_Seq1 c⇩1 l c c⇩2)
note IH = ‹⋀n. c⇩1 ⊢ n -CEdge (p, es, rets)→⇩p Label l ⟹ fst_cmd c = Skip›
from ‹c⇩1;; c⇩2 ⊢ n -CEdge (p, es, rets)→⇩p Label l› ‹labels c⇩1 l c›
have "c⇩1 ⊢ n -CEdge (p, es, rets)→⇩p Label l"
apply - apply(erule Proc_CFG.cases,auto dest:Proc_CFG_Call_Labels)
by(case_tac n')(auto dest:label_less_num_inner_nodes)
from IH[OF this] show ?case by simp
next
case (Labels_Seq2 c⇩2 l c c⇩1)
note IH = ‹⋀n. c⇩2 ⊢ n -CEdge (p, es, rets)→⇩p Label l ⟹ fst_cmd c = Skip›
from ‹c⇩1;; c⇩2 ⊢ n -CEdge (p, es, rets)→⇩p Label (l + #:c⇩1)› ‹labels c⇩2 l c›
obtain nx where "c⇩2 ⊢ nx -CEdge (p, es, rets)→⇩p Label l"
apply - apply(erule Proc_CFG.cases)
apply(auto dest:Proc_CFG_targetlabel_less_num_nodes Proc_CFG_Call_Labels)
by(case_tac n') auto
from IH[OF this] show ?case by simp
next
case (Labels_CondTrue c⇩1 l c b c⇩2)
note IH = ‹⋀n. c⇩1 ⊢ n -CEdge (p, es, rets)→⇩p Label l ⟹ fst_cmd c = Skip›
from ‹if (b) c⇩1 else c⇩2 ⊢ n -CEdge (p, es, rets)→⇩p Label (l + 1)› ‹labels c⇩1 l c›
obtain nx where "c⇩1 ⊢ nx -CEdge (p, es, rets)→⇩p Label l"
apply - apply(erule Proc_CFG.cases,auto)
apply(case_tac n') apply auto
by(case_tac n')(auto dest:label_less_num_inner_nodes)
from IH[OF this] show ?case by simp
next
case (Labels_CondFalse c⇩2 l c b c⇩1)
note IH = ‹⋀n. c⇩2 ⊢ n -CEdge (p, es, rets)→⇩p Label l ⟹ fst_cmd c = Skip›
from ‹if (b) c⇩1 else c⇩2 ⊢ n -CEdge (p, es, rets)→⇩p Label (l + #:c⇩1 + 1)›
‹labels c⇩2 l c›
obtain nx where "c⇩2 ⊢ nx -CEdge (p, es, rets)→⇩p Label l"
apply - apply(erule Proc_CFG.cases,auto)
apply(case_tac n') apply(auto dest:Proc_CFG_targetlabel_less_num_nodes)
by(case_tac n') auto
from IH[OF this] show ?case by simp
next
case (Labels_WhileBody c' l c b)
note IH = ‹⋀n. c' ⊢ n -CEdge (p, es, rets)→⇩p Label l ⟹ fst_cmd c = Skip›
from ‹while (b) c' ⊢ n -CEdge (p, es, rets)→⇩p Label (l + 2)› ‹labels c' l c›
obtain nx where "c' ⊢ nx -CEdge (p, es, rets)→⇩p Label l"
apply - apply(erule Proc_CFG.cases,auto)
by(case_tac n') auto
from IH[OF this] show ?case by simp
next
case (Labels_Call px esx retsx)
from ‹Call px esx retsx ⊢ n -CEdge (p, es, rets)→⇩p Label 1›
show ?case by(fastforce elim:Proc_CFG.cases)
qed(auto dest:Proc_CFG_Call_Labels)
lemma Proc_CFG_Call_source_fst_cmd_Call:
"⟦labels prog l c; prog ⊢ Label l -CEdge (p,es,rets)→⇩p n'⟧
⟹ ∃p es rets. fst_cmd c = Call p es rets"
proof(induct arbitrary:n' rule:labels.induct)
case (Labels_Base c n')
from ‹c ⊢ Label 0 -CEdge (p, es, rets)→⇩p n'› show ?case
by(induct c "Label 0" "CEdge (p, es, rets)" n' rule:Proc_CFG.induct) auto
next
case (Labels_LAss V e n')
from ‹V:=e ⊢ Label 1 -CEdge (p, es, rets)→⇩p n'› show ?case
by(fastforce elim:Proc_CFG.cases)
next
case (Labels_Seq1 c⇩1 l c c⇩2)
note IH = ‹⋀n'. c⇩1 ⊢ Label l -CEdge (p, es, rets)→⇩p n'
⟹ ∃p es rets. fst_cmd c = Call p es rets›
from ‹c⇩1;; c⇩2 ⊢ Label l -CEdge (p, es, rets)→⇩p n'› ‹labels c⇩1 l c›
have "c⇩1 ⊢ Label l -CEdge (p, es, rets)→⇩p n'"
apply - apply(erule Proc_CFG.cases,auto dest:Proc_CFG_Call_Labels)
by(case_tac n)(auto dest:label_less_num_inner_nodes)
from IH[OF this] show ?case by simp
next
case (Labels_Seq2 c⇩2 l c c⇩1)
note IH = ‹⋀n'. c⇩2 ⊢ Label l -CEdge (p, es, rets)→⇩p n'
⟹ ∃p es rets. fst_cmd c = Call p es rets›
from ‹c⇩1;; c⇩2 ⊢ Label (l + #:c⇩1) -CEdge (p, es, rets)→⇩p n'› ‹labels c⇩2 l c›
obtain nx where "c⇩2 ⊢ Label l -CEdge (p, es, rets)→⇩p nx"
apply - apply(erule Proc_CFG.cases)
apply(auto dest:Proc_CFG_sourcelabel_less_num_nodes Proc_CFG_Call_Labels)
by(case_tac n) auto
from IH[OF this] show ?case by simp
next
case (Labels_CondTrue c⇩1 l c b c⇩2)
note IH = ‹⋀n'. c⇩1 ⊢ Label l -CEdge (p, es, rets)→⇩p n'
⟹ ∃p es rets. fst_cmd c = Call p es rets›
from ‹if (b) c⇩1 else c⇩2 ⊢ Label (l + 1) -CEdge (p, es, rets)→⇩p n'› ‹labels c⇩1 l c›
obtain nx where "c⇩1 ⊢ Label l -CEdge (p, es, rets)→⇩p nx"
apply - apply(erule Proc_CFG.cases,auto)
apply(case_tac n) apply auto
by(case_tac n)(auto dest:label_less_num_inner_nodes)
from IH[OF this] show ?case by simp
next
case (Labels_CondFalse c⇩2 l c b c⇩1)
note IH = ‹⋀n'. c⇩2 ⊢ Label l -CEdge (p, es, rets)→⇩p n'
⟹ ∃p es rets. fst_cmd c = Call p es rets›
from ‹if (b) c⇩1 else c⇩2 ⊢ Label (l + #:c⇩1 + 1)-CEdge (p, es, rets)→⇩p n'›
‹labels c⇩2 l c›
obtain nx where "c⇩2 ⊢ Label l -CEdge (p, es, rets)→⇩p nx"
apply - apply(erule Proc_CFG.cases,auto)
apply(case_tac n) apply(auto dest:Proc_CFG_sourcelabel_less_num_nodes)
by(case_tac n) auto
from IH[OF this] show ?case by simp
next
case (Labels_WhileBody c' l c b)
note IH = ‹⋀n'. c' ⊢ Label l -CEdge (p, es, rets)→⇩p n'
⟹ ∃p es rets. fst_cmd c = Call p es rets›
from ‹while (b) c' ⊢ Label (l + 2) -CEdge (p, es, rets)→⇩p n'› ‹labels c' l c›
obtain nx where "c' ⊢ Label l -CEdge (p, es, rets)→⇩p nx"
apply - apply(erule Proc_CFG.cases,auto dest:Proc_CFG_Call_Labels)
by(case_tac n) auto
from IH[OF this] show ?case by simp
next
case (Labels_WhileExit b c' n')
have "while (b) c' ⊢ Label 1 -IEdge ⇑id→⇩p Exit" by(rule Proc_CFG_WhileFalseSkip)
with ‹while (b) c' ⊢ Label 1 -CEdge (p, es, rets)→⇩p n'›
have False by(rule Proc_CFG_Call_Intra_edge_not_same_source)
thus ?case by simp
next
case (Labels_Call px esx retsx)
from ‹Call px esx retsx ⊢ Label 1 -CEdge (p, es, rets)→⇩p n'›
show ?case by(fastforce elim:Proc_CFG.cases)
qed
subsection ‹Definition of ‹Def› and ‹Use› sets›
subsubsection ‹‹ParamDefs››
lemma PCFG_CallEdge_THE_rets:
"prog ⊢ n -CEdge (p,es,rets)→⇩p n'
⟹ (THE rets'. ∃p' es' n. prog ⊢ n -CEdge(p',es',rets')→⇩p n') = rets"
by(fastforce intro:the_equality dest:Proc_CFG_Call_nodes_eq')
definition ParamDefs_proc :: "cmd ⇒ label ⇒ vname list"
where "ParamDefs_proc c n ≡
if (∃n' p' es' rets'. c ⊢ n' -CEdge(p',es',rets')→⇩p n) then
(THE rets'. ∃p' es' n'. c ⊢ n' -CEdge(p',es',rets')→⇩p n)
else []"
lemma in_procs_THE_in_procs_cmd:
"⟦well_formed procs; (p,ins,outs,c) ∈ set procs⟧
⟹ (THE c'. ∃ins' outs'. (p,ins',outs',c') ∈ set procs) = c"
by(fastforce intro:the_equality)
definition ParamDefs :: "wf_prog ⇒ node ⇒ vname list"
where "ParamDefs wfp n ≡ let (prog,procs) = Rep_wf_prog wfp; (p,l) = n in
(if (p = Main) then ParamDefs_proc prog l
else (if (∃ins outs c. (p,ins,outs,c) ∈ set procs)
then ParamDefs_proc (THE c'. ∃ins' outs'. (p,ins',outs',c') ∈ set procs) l
else []))"
lemma ParamDefs_Main_Return_target:
"⟦Rep_wf_prog wfp = (prog,procs); prog ⊢ n -CEdge(p',es,rets)→⇩p n'⟧
⟹ ParamDefs wfp (Main,n') = rets"
by(fastforce dest:PCFG_CallEdge_THE_rets simp:ParamDefs_def ParamDefs_proc_def)
lemma ParamDefs_Proc_Return_target:
assumes "Rep_wf_prog wfp = (prog,procs)"
and "(p,ins,outs,c) ∈ set procs" and "c ⊢ n -CEdge(p',es,rets)→⇩p n'"
shows "ParamDefs wfp (p,n') = rets"
proof -
from ‹Rep_wf_prog wfp = (prog,procs)› have "well_formed procs"
by(fastforce intro:wf_wf_prog)
with ‹(p,ins,outs,c) ∈ set procs› have "p ≠ Main" by fastforce
moreover
from ‹well_formed procs› ‹(p,ins,outs,c) ∈ set procs›
have "(THE c'. ∃ins' outs'. (p,ins',outs',c') ∈ set procs) = c"
by(rule in_procs_THE_in_procs_cmd)
ultimately show ?thesis using assms
by(fastforce dest:PCFG_CallEdge_THE_rets simp:ParamDefs_def ParamDefs_proc_def)
qed
lemma ParamDefs_Main_IEdge_Nil:
"⟦Rep_wf_prog wfp = (prog,procs); prog ⊢ n -IEdge et→⇩p n'⟧
⟹ ParamDefs wfp (Main,n') = []"
by(fastforce dest:Proc_CFG_Call_Intra_edge_not_same_target
simp:ParamDefs_def ParamDefs_proc_def)
lemma ParamDefs_Proc_IEdge_Nil:
assumes "Rep_wf_prog wfp = (prog,procs)"
and "(p,ins,outs,c) ∈ set procs" and "c ⊢ n -IEdge et→⇩p n'"
shows "ParamDefs wfp (p,n') = []"
proof -
from ‹Rep_wf_prog wfp = (prog,procs)› have "well_formed procs"
by(fastforce intro:wf_wf_prog)
with ‹(p,ins,outs,c) ∈ set procs› have "p ≠ Main" by fastforce
moreover
from ‹well_formed procs› ‹(p,ins,outs,c) ∈ set procs›
have "(THE c'. ∃ins' outs'. (p,ins',outs',c') ∈ set procs) = c"
by(rule in_procs_THE_in_procs_cmd)
ultimately show ?thesis using assms
by(fastforce dest:Proc_CFG_Call_Intra_edge_not_same_target
simp:ParamDefs_def ParamDefs_proc_def)
qed
lemma ParamDefs_Main_CEdge_Nil:
"⟦Rep_wf_prog wfp = (prog,procs); prog ⊢ n' -CEdge(p',es,rets)→⇩p n''⟧
⟹ ParamDefs wfp (Main,n') = []"
by(fastforce dest:Proc_CFG_Call_targetnode_no_Call_sourcenode
simp:ParamDefs_def ParamDefs_proc_def)
lemma ParamDefs_Proc_CEdge_Nil:
assumes "Rep_wf_prog wfp = (prog,procs)"
and "(p,ins,outs,c) ∈ set procs" and "c ⊢ n' -CEdge(p',es,rets)→⇩p n''"
shows "ParamDefs wfp (p,n') = []"
proof -
from ‹Rep_wf_prog wfp = (prog,procs)› have "well_formed procs"
by(fastforce intro:wf_wf_prog)
with ‹(p,ins,outs,c) ∈ set procs› have "p ≠ Main" by fastforce
moreover
from ‹well_formed procs› ‹(p,ins,outs,c) ∈ set procs›
have "(THE c'. ∃ins' outs'. (p,ins',outs',c') ∈ set procs) = c"
by(rule in_procs_THE_in_procs_cmd)
ultimately show ?thesis using assms
by(fastforce dest:Proc_CFG_Call_targetnode_no_Call_sourcenode
simp:ParamDefs_def ParamDefs_proc_def)
qed
lemma assumes "valid_edge wfp a" and "kind a = Q'↩⇘p⇙f'"
and "(p, ins, outs) ∈ set (lift_procs wfp)"
shows ParamDefs_length:"length (ParamDefs wfp (targetnode a)) = length outs"
(is ?length)
and Return_update:"f' cf cf' = cf'(ParamDefs wfp (targetnode a) [:=] map cf outs)"
(is ?update)
proof -
from Rep_wf_prog[of wfp]
obtain prog procs where [simp]:"Rep_wf_prog wfp = (prog,procs)"
by(fastforce simp:wf_prog_def)
hence "wf prog procs" by(rule wf_wf_prog)
hence wf:"well_formed procs" by fastforce
from assms have "prog,procs ⊢ sourcenode a -kind a→ targetnode a"
by(simp add:valid_edge_def)
from this ‹kind a = Q'↩⇘p⇙f'› wf have "?length ∧ ?update"
proof(induct "sourcenode a" "kind a" "targetnode a" rule:PCFG.induct)
case (MainReturn l p' es rets l' insx outsx cx)
from ‹λcf. snd cf = (Main, Label l')↩⇘p'⇙λcf cf'. cf'(rets [:=] map cf outsx) =
kind a› ‹kind a = Q'↩⇘p⇙f'› have "p' = p"
and f':"f' = (λcf cf'. cf'(rets [:=] map cf outsx))" by simp_all
with ‹well_formed procs› ‹(p', insx, outsx, cx) ∈ set procs›
‹(p, ins, outs) ∈ set (lift_procs wfp)›
have [simp]:"outsx = outs" by fastforce
from ‹prog ⊢ Label l -CEdge (p', es, rets)→⇩p Label l'›
have "containsCall procs prog [] p'" by(rule Proc_CFG_Call_containsCall)
with ‹wf prog procs› ‹(p', insx, outsx, cx) ∈ set procs›
‹prog ⊢ Label l -CEdge (p', es, rets)→⇩p Label l'›
have "length rets = length outs" by fastforce
from ‹prog ⊢ Label l -CEdge (p', es, rets)→⇩p Label l'›
have "ParamDefs wfp (Main,Label l') = rets"
by(fastforce intro:ParamDefs_Main_Return_target)
with ‹(Main, Label l') = targetnode a› f' ‹length rets = length outs›
show ?thesis by simp
next
case (ProcReturn px insx outsx cx l p' es rets l' ins' outs' c' ps)
from ‹λcf. snd cf = (px, Label l')↩⇘p'⇙λcf cf'. cf'(rets [:=] map cf outs') =
kind a› ‹kind a = Q'↩⇘p⇙f'›
have "p' = p" and f':"f' = (λcf cf'. cf'(rets [:=] map cf outs'))"
by simp_all
with ‹well_formed procs› ‹(p', ins', outs', c') ∈ set procs›
‹(p, ins, outs) ∈ set (lift_procs wfp)›
have [simp]:"outs' = outs" by fastforce
from ‹cx ⊢ Label l -CEdge (p', es, rets)→⇩p Label l'›
have "containsCall procs cx [] p'" by(rule Proc_CFG_Call_containsCall)
with ‹containsCall procs prog ps px› ‹(px, insx, outsx, cx) ∈ set procs›
have "containsCall procs prog (ps@[px]) p'" by(rule containsCall_in_proc)
with ‹wf prog procs› ‹(p', ins', outs', c') ∈ set procs›
‹cx ⊢ Label l -CEdge (p', es, rets)→⇩p Label l'›
have "length rets = length outs" by fastforce
from ‹(px, insx, outsx, cx) ∈ set procs›
‹cx ⊢ Label l -CEdge (p', es, rets)→⇩p Label l'›
have "ParamDefs wfp (px,Label l') = rets"
by(fastforce intro:ParamDefs_Proc_Return_target simp:set_conv_nth)
with ‹(px, Label l') = targetnode a› f' ‹length rets = length outs›
show ?thesis by simp
qed auto
thus "?length" and "?update" by simp_all
qed
subsubsection ‹‹ParamUses››
fun fv :: "expr ⇒ vname set"
where
"fv (Val v) = {}"
| "fv (Var V) = {V}"
| "fv (e1 «bop» e2) = (fv e1 ∪ fv e2)"
lemma rhs_interpret_eq:
"⟦state_check cf e v'; ∀V ∈ fv e. cf V = cf' V⟧
⟹ state_check cf' e v'"
proof(induct e arbitrary:v')
case (Val v)
from ‹state_check cf (Val v) v'› have "v' = Some v"
by(fastforce elim:interpret.cases)
thus ?case by simp
next
case (Var V)
hence "cf' (V) = v'" by(fastforce elim:interpret.cases)
thus ?case by simp
next
case (BinOp b1 bop b2)
note IH1 = ‹⋀v'. ⟦state_check cf b1 v'; ∀V∈fv b1. cf V = cf' V⟧
⟹ state_check cf' b1 v'›
note IH2 = ‹⋀v'. ⟦state_check cf b2 v'; ∀V∈fv b2. cf V = cf' V⟧
⟹ state_check cf' b2 v'›
from ‹∀V ∈ fv (b1 «bop» b2). cf V = cf' V› have "∀V ∈ fv b1. cf V = cf' V"
and "∀V ∈ fv b2. cf V = cf' V" by simp_all
from ‹state_check cf (b1 «bop» b2) v'›
have "((state_check cf b1 None ∧ v' = None) ∨
(state_check cf b2 None ∧ v' = None)) ∨
(∃v⇩1 v⇩2. state_check cf b1 (Some v⇩1) ∧ state_check cf b2 (Some v⇩2) ∧
binop bop v⇩1 v⇩2 = v')"
apply(cases "interpret b1 cf",simp)
apply(cases "interpret b2 cf",simp)
by(case_tac "binop bop a aa",simp+)
thus ?case apply -
proof(erule disjE)+
assume "state_check cf b1 None ∧ v' = None"
hence check:"state_check cf b1 None" and "v' = None" by simp_all
from IH1[OF check ‹∀V ∈ fv b1. cf V = cf' V›] have "state_check cf' b1 None" .
with ‹v' = None› show ?case by simp
next
assume "state_check cf b2 None ∧ v' = None"
hence check:"state_check cf b2 None" and "v' = None" by simp_all
from IH2[OF check ‹∀V ∈ fv b2. cf V = cf' V›] have "state_check cf' b2 None" .
with ‹v' = None› show ?case by(cases "interpret b1 cf'") simp+
next
assume "∃v⇩1 v⇩2. state_check cf b1 (Some v⇩1) ∧
state_check cf b2 (Some v⇩2) ∧ binop bop v⇩1 v⇩2 = v'"
then obtain v⇩1 v⇩2 where "state_check cf b1 (Some v⇩1)"
and "state_check cf b2 (Some v⇩2)" and "binop bop v⇩1 v⇩2 = v'" by blast
from ‹∀V ∈ fv (b1 «bop» b2). cf V = cf' V› have "∀V ∈ fv b1. cf V = cf' V"
by simp
from IH1[OF ‹state_check cf b1 (Some v⇩1)› this]
have "interpret b1 cf' = Some v⇩1" .
from ‹∀V ∈ fv (b1 «bop» b2). cf V = cf' V› have "∀V ∈ fv b2. cf V = cf' V"
by simp
from IH2[OF ‹state_check cf b2 (Some v⇩2)› this]
have "interpret b2 cf' = Some v⇩2" .
with ‹interpret b1 cf' = Some v⇩1› ‹binop bop v⇩1 v⇩2 = v'›
show ?thesis by(cases v') simp+
qed
qed
lemma PCFG_CallEdge_THE_es:
"prog ⊢ n -CEdge(p,es,rets)→⇩p n'
⟹ (THE es'. ∃p' rets' n'. prog ⊢ n -CEdge(p',es',rets')→⇩p n') = es"
by(fastforce intro:the_equality dest:Proc_CFG_Call_nodes_eq)
definition ParamUses_proc :: "cmd ⇒ label ⇒ vname set list"
where "ParamUses_proc c n ≡
if (∃n' p' es' rets'. c ⊢ n -CEdge(p',es',rets')→⇩p n') then
(map fv (THE es'. ∃p' rets' n'. c ⊢ n -CEdge(p',es',rets')→⇩p n'))
else []"
definition ParamUses :: "wf_prog ⇒ node ⇒ vname set list"
where "ParamUses wfp n ≡ let (prog,procs) = Rep_wf_prog wfp; (p,l) = n in
(if (p = Main) then ParamUses_proc prog l
else (if (∃ins outs c. (p,ins,outs,c) ∈ set procs)
then ParamUses_proc (THE c'. ∃ins' outs'. (p,ins',outs',c') ∈ set procs) l
else []))"
lemma ParamUses_Main_Return_target:
"⟦Rep_wf_prog wfp = (prog,procs); prog ⊢ n -CEdge(p',es,rets)→⇩p n' ⟧
⟹ ParamUses wfp (Main,n) = map fv es"
by(fastforce dest:PCFG_CallEdge_THE_es simp:ParamUses_def ParamUses_proc_def)
lemma ParamUses_Proc_Return_target:
assumes "Rep_wf_prog wfp = (prog,procs)"
and "(p,ins,outs,c) ∈ set procs" and "c ⊢ n -CEdge(p',es,rets)→⇩p n'"
shows "ParamUses wfp (p,n) = map fv es"
proof -
from ‹Rep_wf_prog wfp = (prog,procs)› have "well_formed procs"
by(fastforce intro:wf_wf_prog)
with ‹(p,ins,outs,c) ∈ set procs› have "p ≠ Main" by fastforce
moreover
from ‹well_formed procs› ‹(p,ins,outs,c) ∈ set procs›
have "(THE c'. ∃ins' outs'. (p,ins',outs',c') ∈ set procs) = c"
by(rule in_procs_THE_in_procs_cmd)
ultimately show ?thesis using assms
by(fastforce dest:PCFG_CallEdge_THE_es simp:ParamUses_def ParamUses_proc_def)
qed
lemma ParamUses_Main_IEdge_Nil:
"⟦Rep_wf_prog wfp = (prog,procs); prog ⊢ n -IEdge et→⇩p n'⟧
⟹ ParamUses wfp (Main,n) = []"
by(fastforce dest:Proc_CFG_Call_Intra_edge_not_same_source
simp:ParamUses_def ParamUses_proc_def)
lemma ParamUses_Proc_IEdge_Nil:
assumes "Rep_wf_prog wfp = (prog,procs)"
and "(p,ins,outs,c) ∈ set procs" and "c ⊢ n -IEdge et→⇩p n'"
shows "ParamUses wfp (p,n) = []"
proof -
from ‹Rep_wf_prog wfp = (prog,procs)› have "well_formed procs"
by(fastforce intro:wf_wf_prog)
with ‹(p,ins,outs,c) ∈ set procs› have "p ≠ Main" by fastforce
moreover
from ‹well_formed procs› ‹(p,ins,outs,c) ∈ set procs›
have "(THE c'. ∃ins' outs'. (p,ins',outs',c') ∈ set procs) = c"
by(rule in_procs_THE_in_procs_cmd)
ultimately show ?thesis using assms
by(fastforce dest:Proc_CFG_Call_Intra_edge_not_same_source
simp:ParamUses_def ParamUses_proc_def)
qed
lemma ParamUses_Main_CEdge_Nil:
"⟦Rep_wf_prog wfp = (prog,procs); prog ⊢ n' -CEdge(p',es,rets)→⇩p n⟧
⟹ ParamUses wfp (Main,n) = []"
by(fastforce dest:Proc_CFG_Call_targetnode_no_Call_sourcenode
simp:ParamUses_def ParamUses_proc_def)
lemma ParamUses_Proc_CEdge_Nil:
assumes "Rep_wf_prog wfp = (prog,procs)"
and "(p,ins,outs,c) ∈ set procs" and "c ⊢ n' -CEdge(p',es,rets)→⇩p n"
shows "ParamUses wfp (p,n) = []"
proof -
from ‹Rep_wf_prog wfp = (prog,procs)› have "well_formed procs"
by(fastforce intro:wf_wf_prog)
with ‹(p,ins,outs,c) ∈ set procs› have "p ≠ Main" by fastforce
moreover
from ‹well_formed procs›
‹(p,ins,outs,c) ∈ set procs›
have "(THE c'. ∃ins' outs'. (p,ins',outs',c') ∈ set procs) = c"
by(rule in_procs_THE_in_procs_cmd)
ultimately show ?thesis using assms
by(fastforce dest:Proc_CFG_Call_targetnode_no_Call_sourcenode
simp:ParamUses_def ParamUses_proc_def)
qed
subsubsection ‹‹Def››
fun lhs :: "cmd ⇒ vname set"
where
"lhs Skip = {}"
| "lhs (V:=e) = {V}"
| "lhs (c⇩1;;c⇩2) = lhs c⇩1"
| "lhs (if (b) c⇩1 else c⇩2) = {}"
| "lhs (while (b) c) = {}"
| "lhs (Call p es rets) = {}"
lemma lhs_fst_cmd:"lhs (fst_cmd c) = lhs c" by(induct c) auto
lemma Proc_CFG_Call_source_empty_lhs:
assumes "prog ⊢ Label l -CEdge (p,es,rets)→⇩p n'"
shows "lhs (label prog l) = {}"
proof -
from ‹prog ⊢ Label l -CEdge (p,es,rets)→⇩p n'› have "l < #:prog"
by(rule Proc_CFG_sourcelabel_less_num_nodes)
then obtain c' where "labels prog l c'"
by(erule less_num_inner_nodes_label)
hence "label prog l = c'" by(rule labels_label)
from ‹labels prog l c'› ‹prog ⊢ Label l -CEdge (p,es,rets)→⇩p n'›
have "∃p es rets. fst_cmd c' = Call p es rets"
by(rule Proc_CFG_Call_source_fst_cmd_Call)
with lhs_fst_cmd[of c'] have "lhs c' = {}" by auto
with ‹label prog l = c'› show ?thesis by simp
qed
lemma in_procs_THE_in_procs_ins:
"⟦well_formed procs; (p,ins,outs,c) ∈ set procs⟧
⟹ (THE ins'. ∃c' outs'. (p,ins',outs',c') ∈ set procs) = ins"
by(fastforce intro:the_equality)
definition Def :: "wf_prog ⇒ node ⇒ vname set"
where "Def wfp n ≡ (let (prog,procs) = Rep_wf_prog wfp; (p,l) = n in
(case l of Label lx ⇒
(if p = Main then lhs (label prog lx)
else (if (∃ins outs c. (p,ins,outs,c) ∈ set procs)
then
lhs (label (THE c'. ∃ins' outs'. (p,ins',outs',c') ∈ set procs) lx)
else {}))
| Entry ⇒ if (∃ins outs c. (p,ins,outs,c) ∈ set procs)
then (set
(THE ins'. ∃c' outs'. (p,ins',outs',c') ∈ set procs)) else {}
| Exit ⇒ {}))
∪ set (ParamDefs wfp n)"
lemma Entry_Def_empty:"Def wfp (Main, Entry) = {}"
proof -
obtain prog procs where [simp]:"Rep_wf_prog wfp = (prog,procs)"
by(cases "Rep_wf_prog wfp") auto
hence "well_formed procs" by(fastforce intro:wf_wf_prog)
thus ?thesis by(auto simp:Def_def ParamDefs_def ParamDefs_proc_def)
qed
lemma Exit_Def_empty:"Def wfp (Main, Exit) = {}"
proof -
obtain prog procs where [simp]:"Rep_wf_prog wfp = (prog,procs)"
by(cases "Rep_wf_prog wfp") auto
hence "well_formed procs" by(fastforce intro:wf_wf_prog)
thus ?thesis
by(auto dest:Proc_CFG_Call_Labels simp:Def_def ParamDefs_def ParamDefs_proc_def)
qed
subsubsection ‹‹Use››
fun rhs :: "cmd ⇒ vname set"
where
"rhs Skip = {}"
| "rhs (V:=e) = fv e"
| "rhs (c⇩1;;c⇩2) = rhs c⇩1"
| "rhs (if (b) c⇩1 else c⇩2) = fv b"
| "rhs (while (b) c) = fv b"
| "rhs (Call p es rets) = {}"
lemma rhs_fst_cmd:"rhs (fst_cmd c) = rhs c" by(induct c) auto
lemma Proc_CFG_Call_target_empty_rhs:
assumes "prog ⊢ n -CEdge (p,es,rets)→⇩p Label l'"
shows "rhs (label prog l') = {}"
proof -
from ‹prog ⊢ n -CEdge (p,es,rets)→⇩p Label l'› have "l' < #:prog"
by(rule Proc_CFG_targetlabel_less_num_nodes)
then obtain c' where "labels prog l' c'"
by(erule less_num_inner_nodes_label)
hence "label prog l' = c'" by(rule labels_label)
from ‹labels prog l' c'› ‹prog ⊢ n -CEdge (p,es,rets)→⇩p Label l'›
have "fst_cmd c' = Skip" by(rule Proc_CFG_Call_target_fst_cmd_Skip)
with rhs_fst_cmd[of c'] have "rhs c' = {}" by simp
with ‹label prog l' = c'› show ?thesis by simp
qed
lemma in_procs_THE_in_procs_outs:
"⟦well_formed procs; (p,ins,outs,c) ∈ set procs⟧
⟹ (THE outs'. ∃c' ins'. (p,ins',outs',c') ∈ set procs) = outs"
by(fastforce intro:the_equality)
definition Use :: "wf_prog ⇒ node ⇒ vname set"
where "Use wfp n ≡ (let (prog,procs) = Rep_wf_prog wfp; (p,l) = n in
(case l of Label lx ⇒
(if p = Main then rhs (label prog lx)
else (if (∃ins outs c. (p,ins,outs,c) ∈ set procs)
then
rhs (label (THE c'. ∃ins' outs'. (p,ins',outs',c') ∈ set procs) lx)
else {}))
| Exit ⇒ if (∃ins outs c. (p,ins,outs,c) ∈ set procs)
then (set (THE outs'. ∃c' ins'. (p,ins',outs',c') ∈ set procs) )
else {}
| Entry ⇒ if (∃ins outs c. (p,ins,outs,c) ∈ set procs)
then (set (THE ins'. ∃c' outs'. (p,ins',outs',c') ∈ set procs))
else {}))
∪ Union (set (ParamUses wfp n)) ∪ set (ParamDefs wfp n)"
lemma Entry_Use_empty:"Use wfp (Main, Entry) = {}"
proof -
obtain prog procs where [simp]:"Rep_wf_prog wfp = (prog,procs)"
by(cases "Rep_wf_prog wfp") auto
hence "well_formed procs" by(fastforce intro:wf_wf_prog)
thus ?thesis by(auto dest:Proc_CFG_Call_Labels
simp:Use_def ParamUses_def ParamUses_proc_def ParamDefs_def ParamDefs_proc_def)
qed
lemma Exit_Use_empty:"Use wfp (Main, Exit) = {}"
proof -
obtain prog procs where [simp]:"Rep_wf_prog wfp = (prog,procs)"
by(cases "Rep_wf_prog wfp") auto
hence "well_formed procs" by(fastforce intro:wf_wf_prog)
thus ?thesis by(auto dest:Proc_CFG_Call_Labels
simp:Use_def ParamUses_def ParamUses_proc_def ParamDefs_def ParamDefs_proc_def)
qed
subsection ‹Lemmas about edges and call frames›
lemmas transfers_simps = ProcCFG.transfer.simps[simplified]
declare transfers_simps [simp]
abbreviation state_val :: "(('var ⇀ 'val) × 'ret) list ⇒ 'var ⇀ 'val"
where "state_val s V ≡ (fst (hd s)) V"
lemma Proc_CFG_edge_no_lhs_equal:
assumes "prog ⊢ Label l -IEdge et→⇩p n'" and "V ∉ lhs (label prog l)"
shows "state_val (CFG.transfer (lift_procs wfp) et (cf#cfs)) V = fst cf V"
proof -
from ‹prog ⊢ Label l -IEdge et→⇩p n'›
obtain x where "IEdge et = x" and "prog ⊢ Label l -x→⇩p n'" by simp_all
from ‹prog ⊢ Label l -x→⇩p n'› ‹IEdge et = x› ‹V ∉ lhs (label prog l)›
show ?thesis
proof(induct prog "Label l" x n' arbitrary:l rule:Proc_CFG.induct)
case (Proc_CFG_LAss V' e)
have "labels (V':=e) 0 (V':=e)" by(rule Labels_Base)
hence "label (V':=e) 0 = (V':=e)" by(rule labels_label)
have "V' ∈ lhs (V':=e)" by simp
with ‹V ∉ lhs (label (V':=e) 0)›
‹IEdge et = IEdge ⇑λcf. update cf V' e› ‹label (V':=e) 0 = (V':=e)›
show ?case by fastforce
next
case (Proc_CFG_SeqFirst c⇩1 et' n' c⇩2)
note IH = ‹⟦IEdge et = et'; V ∉ lhs (label c⇩1 l)⟧
⟹ state_val (CFG.transfer (lift_procs wfp) et (cf # cfs)) V = fst cf V›
from ‹c⇩1 ⊢ Label l -et'→⇩p n'› have "l < #:c⇩1"
by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
then obtain c' where "labels c⇩1 l c'" by(erule less_num_inner_nodes_label)
hence "labels (c⇩1;;c⇩2) l (c';;c⇩2)" by(rule Labels_Seq1)
hence "label (c⇩1;;c⇩2) l = c';;c⇩2" by(rule labels_label)
with ‹V ∉ lhs (label (c⇩1;; c⇩2) l)› ‹labels c⇩1 l c'›
have "V ∉ lhs (label c⇩1 l)" by(fastforce dest:labels_label)
with ‹IEdge et = et'› show ?case by (rule IH)
next
case (Proc_CFG_SeqConnect c⇩1 et' c⇩2)
note IH = ‹⟦IEdge et = et'; V ∉ lhs (label c⇩1 l)⟧
⟹ state_val (CFG.transfer (lift_procs wfp) et (cf # cfs)) V = fst cf V›
from ‹c⇩1 ⊢ Label l -et'→⇩p Exit› have "l < #:c⇩1"
by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
then obtain c' where "labels c⇩1 l c'" by(erule less_num_inner_nodes_label)
hence "labels (c⇩1;;c⇩2) l (c';;c⇩2)" by(rule Labels_Seq1)
hence "label (c⇩1;;c⇩2) l = c';;c⇩2" by(rule labels_label)
with ‹V ∉ lhs (label (c⇩1;; c⇩2) l)› ‹labels c⇩1 l c'›
have "V ∉ lhs (label c⇩1 l)" by(fastforce dest:labels_label)
with ‹IEdge et = et'› show ?case by (rule IH)
next
case (Proc_CFG_SeqSecond c⇩2 n et' n' c⇩1 l)
note IH = ‹⋀l. ⟦n = Label l; IEdge et = et'; V ∉ lhs (label c⇩2 l)⟧
⟹ state_val (CFG.transfer (lift_procs wfp) et (cf # cfs)) V = fst cf V›
from ‹n ⊕ #:c⇩1 = Label l› obtain l'
where "n = Label l'" and "l = l' + #:c⇩1" by(cases n) auto
from ‹n = Label l'› ‹c⇩2 ⊢ n -et'→⇩p n'› have "l' < #:c⇩2"
by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
then obtain c' where "labels c⇩2 l' c'" by(erule less_num_inner_nodes_label)
with ‹l = l' + #:c⇩1› have "labels (c⇩1;;c⇩2) l c'"
by(fastforce intro:Labels_Seq2)
hence "label (c⇩1;;c⇩2) l = c'" by(rule labels_label)
with ‹V ∉ lhs (label (c⇩1;;c⇩2) l)› ‹labels c⇩2 l' c'› ‹l = l' + #:c⇩1›
have "V ∉ lhs (label c⇩2 l')" by(fastforce dest:labels_label)
with ‹n = Label l'› ‹IEdge et = et'› show ?case by (rule IH)
next
case (Proc_CFG_CondThen c⇩1 n et' n' b c⇩2 l)
note IH = ‹⋀l. ⟦n = Label l; IEdge et = et'; V ∉ lhs (label c⇩1 l)⟧
⟹ state_val (CFG.transfer (lift_procs wfp) et (cf # cfs)) V = fst cf V›
from ‹n ⊕ 1 = Label l› obtain l'
where "n = Label l'" and "l = l' + 1" by(cases n) auto
from ‹n = Label l'› ‹c⇩1 ⊢ n -et'→⇩p n'› have "l' < #:c⇩1"
by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
then obtain c' where "labels c⇩1 l' c'" by(erule less_num_inner_nodes_label)
with ‹l = l' + 1› have "labels (if (b) c⇩1 else c⇩2) l c'"
by(fastforce intro:Labels_CondTrue)
hence "label (if (b) c⇩1 else c⇩2) l = c'" by(rule labels_label)
with ‹V ∉ lhs (label (if (b) c⇩1 else c⇩2) l)› ‹labels c⇩1 l' c'› ‹l = l' + 1›
have "V ∉ lhs (label c⇩1 l')" by(fastforce dest:labels_label)
with ‹n = Label l'› ‹IEdge et = et'› show ?case by (rule IH)
next
case (Proc_CFG_CondElse c⇩2 n et' n' b c⇩1 l)
note IH = ‹⋀l. ⟦n = Label l; IEdge et = et'; V ∉ lhs (label c⇩2 l)⟧
⟹ state_val (CFG.transfer (lift_procs wfp) et (cf # cfs)) V = fst cf V›
from ‹n ⊕ #:c⇩1 + 1 = Label l› obtain l'
where "n = Label l'" and "l = l' + #:c⇩1 + 1" by(cases n) auto
from ‹n = Label l'› ‹c⇩2 ⊢ n -et'→⇩p n'› have "l' < #:c⇩2"
by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
then obtain c' where "labels c⇩2 l' c'" by(erule less_num_inner_nodes_label)
with ‹l = l' + #:c⇩1 + 1› have "labels (if (b) c⇩1 else c⇩2) l c'"
by(fastforce intro:Labels_CondFalse)
hence "label (if (b) c⇩1 else c⇩2) l = c'" by(rule labels_label)
with ‹V ∉ lhs (label (if (b) c⇩1 else c⇩2) l)› ‹labels c⇩2 l' c'› ‹l = l' + #:c⇩1 + 1›
have "V ∉ lhs (label c⇩2 l')" by(fastforce dest:labels_label)
with ‹n = Label l'› ‹IEdge et = et'› show ?case by (rule IH)
next
case (Proc_CFG_WhileBody c' n et' n' b l)
note IH = ‹⋀l. ⟦n = Label l; IEdge et = et'; V ∉ lhs (label c' l)⟧
⟹ state_val (CFG.transfer (lift_procs wfp) et (cf # cfs)) V = fst cf V›
from ‹n ⊕ 2 = Label l› obtain l'
where "n = Label l'" and "l = l' + 2" by(cases n) auto
from ‹n = Label l'› ‹c' ⊢ n -et'→⇩p n'› have "l' < #:c'"
by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
then obtain cx where "labels c' l' cx" by(erule less_num_inner_nodes_label)
with ‹l = l' + 2› have "labels (while (b) c') l (cx;;while (b) c')"
by(fastforce intro:Labels_WhileBody)
hence "label (while (b) c') l = cx;;while (b) c'" by(rule labels_label)
with ‹V ∉ lhs (label (while (b) c') l)› ‹labels c' l' cx› ‹l = l' + 2›
have "V ∉ lhs (label c' l')" by(fastforce dest:labels_label)
with ‹n = Label l'› ‹IEdge et = et'› show ?case by (rule IH)
next
case (Proc_CFG_WhileBodyExit c' n et' b l)
note IH = ‹⋀l. ⟦n = Label l; IEdge et = et'; V ∉ lhs (label c' l)⟧
⟹ state_val (CFG.transfer (lift_procs wfp) et (cf # cfs)) V = fst cf V›
from ‹n ⊕ 2 = Label l› obtain l'
where "n = Label l'" and "l = l' + 2" by(cases n) auto
from ‹n = Label l'› ‹c' ⊢ n -et'→⇩p Exit› have "l' < #:c'"
by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
then obtain cx where "labels c' l' cx" by(erule less_num_inner_nodes_label)
with ‹l = l' + 2› have "labels (while (b) c') l (cx;;while (b) c')"
by(fastforce intro:Labels_WhileBody)
hence "label (while (b) c') l = cx;;while (b) c'" by(rule labels_label)
with ‹V ∉ lhs (label (while (b) c') l)› ‹labels c' l' cx› ‹l = l' + 2›
have "V ∉ lhs (label c' l')" by(fastforce dest:labels_label)
with ‹n = Label l'› ‹IEdge et = et'› show ?case by (rule IH)
qed auto
qed
lemma Proc_CFG_edge_uses_only_rhs:
assumes "prog ⊢ Label l -IEdge et→⇩p n'" and "CFG.pred et s"
and "CFG.pred et s'" and "∀V∈rhs (label prog l). state_val s V = state_val s' V"
shows "∀V∈lhs (label prog l).
state_val (CFG.transfer (lift_procs wfp) et s) V =
state_val (CFG.transfer (lift_procs wfp) et s') V"
proof -
from ‹prog ⊢ Label l -IEdge et→⇩p n'›
obtain x where "IEdge et = x" and "prog ⊢ Label l -x→⇩p n'" by simp_all
from ‹CFG.pred et s› obtain cf cfs where [simp]:"s = cf#cfs" by(cases s) auto
from ‹CFG.pred et s'› obtain cf' cfs' where [simp]:"s' = cf'#cfs'"
by(cases s') auto
from ‹prog ⊢ Label l -x→⇩p n'› ‹IEdge et = x›
‹∀V∈rhs (label prog l). state_val s V = state_val s' V›
show ?thesis
proof(induct prog "Label l" x n' arbitrary:l rule:Proc_CFG.induct)
case Proc_CFG_Skip
have "labels Skip 0 Skip" by(rule Labels_Base)
hence "label Skip 0 = Skip" by(rule labels_label)
hence "∀V. V ∉ lhs (label Skip 0)" by simp
then show ?case by fastforce
next
case (Proc_CFG_LAss V e)
have "labels (V:=e) 0 (V:=e)" by(rule Labels_Base)
hence "label (V:=e) 0 = V:=e" by(rule labels_label)
then have "lhs (label (V:=e) 0) = {V}"
and "rhs (label (V:=e) 0) = fv e" by auto
with ‹IEdge et = IEdge ⇑λcf. update cf V e›
‹∀V∈rhs (label (V:=e) 0). state_val s V = state_val s' V›
show ?case by(fastforce intro:rhs_interpret_eq)
next
case (Proc_CFG_LAssSkip V e)
have "labels (V:=e) 1 Skip" by(rule Labels_LAss)
hence "label (V:=e) 1 = Skip" by(rule labels_label)
hence "∀V'. V' ∉ lhs (label (V:=e) 1)" by simp
then show ?case by fastforce
next
case (Proc_CFG_SeqFirst c⇩1 et' n' c⇩2)
note IH = ‹⟦IEdge et = et';
∀V∈rhs (label c⇩1 l). state_val s V = state_val s' V⟧
⟹ ∀V∈lhs (label c⇩1 l). state_val (CFG.transfer (lift_procs wfp) et s) V =
state_val (CFG.transfer (lift_procs wfp) et s') V›
from ‹c⇩1 ⊢ Label l -et'→⇩p n'›
have "l < #:c⇩1" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
then obtain c' where "labels c⇩1 l c'" by(erule less_num_inner_nodes_label)
hence "labels (c⇩1;;c⇩2) l (c';;c⇩2)" by(rule Labels_Seq1)
with ‹labels c⇩1 l c'› ‹∀V∈rhs (label (c⇩1;; c⇩2) l). state_val s V = state_val s' V›
have "∀V∈rhs (label c⇩1 l). state_val s V = state_val s' V"
by(fastforce dest:labels_label)
with ‹IEdge et = et'›
have "∀V∈lhs (label c⇩1 l). state_val (CFG.transfer (lift_procs wfp) et s) V =
state_val (CFG.transfer (lift_procs wfp) et s') V" by (rule IH)
with ‹labels c⇩1 l c'› ‹labels (c⇩1;;c⇩2) l (c';;c⇩2)›
show ?case by(fastforce dest:labels_label)
next
case (Proc_CFG_SeqConnect c⇩1 et' c⇩2)
note IH = ‹⟦IEdge et = et';
∀V∈rhs (label c⇩1 l). state_val s V = state_val s' V⟧
⟹ ∀V∈lhs (label c⇩1 l). state_val (CFG.transfer (lift_procs wfp) et s) V =
state_val (CFG.transfer (lift_procs wfp) et s') V›
from ‹c⇩1 ⊢ Label l -et'→⇩p Exit›
have "l < #:c⇩1" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
then obtain c' where "labels c⇩1 l c'" by(erule less_num_inner_nodes_label)
hence "labels (c⇩1;;c⇩2) l (c';;c⇩2)" by(rule Labels_Seq1)
with ‹labels c⇩1 l c'› ‹∀V∈rhs (label (c⇩1;; c⇩2) l). state_val s V = state_val s' V›
have "∀V∈rhs (label c⇩1 l). state_val s V = state_val s' V"
by(fastforce dest:labels_label)
with ‹IEdge et = et'›
have "∀V∈lhs (label c⇩1 l). state_val (CFG.transfer (lift_procs wfp) et s) V =
state_val (CFG.transfer (lift_procs wfp) et s') V" by (rule IH)
with ‹labels c⇩1 l c'› ‹labels (c⇩1;;c⇩2) l (c';;c⇩2)›
show ?case by(fastforce dest:labels_label)
next
case (Proc_CFG_SeqSecond c⇩2 n et' n' c⇩1)
note IH = ‹⋀l. ⟦n = Label l; IEdge et = et';
∀V∈rhs (label c⇩2 l). state_val s V = state_val s' V⟧
⟹ ∀V∈lhs (label c⇩2 l). state_val (CFG.transfer (lift_procs wfp) et s) V =
state_val (CFG.transfer (lift_procs wfp) et s') V›
from ‹n ⊕ #:c⇩1 = Label l› obtain l' where "n = Label l'" and "l = l' + #:c⇩1"
by(cases n) auto
from ‹c⇩2 ⊢ n -et'→⇩p n'› ‹n = Label l'›
have "l' < #:c⇩2" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
then obtain c' where "labels c⇩2 l' c'" by(erule less_num_inner_nodes_label)
with ‹l = l' + #:c⇩1› have "labels (c⇩1;;c⇩2) l c'" by(fastforce intro:Labels_Seq2)
with ‹labels c⇩2 l' c'› ‹∀V∈rhs (label (c⇩1;;c⇩2) l). state_val s V = state_val s' V›
have "∀V∈rhs (label c⇩2 l'). state_val s V = state_val s' V"
by(fastforce dest:labels_label)
with ‹n = Label l'› ‹IEdge et = et'›
have "∀V∈lhs (label c⇩2 l'). state_val (CFG.transfer (lift_procs wfp) et s) V =
state_val (CFG.transfer (lift_procs wfp) et s') V" by (rule IH)
with ‹labels c⇩2 l' c'› ‹labels (c⇩1;;c⇩2) l c'›
show ?case by(fastforce dest:labels_label)
next
case (Proc_CFG_CondTrue b c⇩1 c⇩2)
have "labels (if (b) c⇩1 else c⇩2) 0 (if (b) c⇩1 else c⇩2)" by(rule Labels_Base)
hence "label (if (b) c⇩1 else c⇩2) 0 = if (b) c⇩1 else c⇩2" by(rule labels_label)
hence "∀V. V ∉ lhs (label (if (b) c⇩1 else c⇩2) 0)" by simp
then show ?case by fastforce
next
case (Proc_CFG_CondFalse b c⇩1 c⇩2)
have "labels (if (b) c⇩1 else c⇩2) 0 (if (b) c⇩1 else c⇩2)" by(rule Labels_Base)
hence "label (if (b) c⇩1 else c⇩2) 0 = if (b) c⇩1 else c⇩2" by(rule labels_label)
hence "∀V. V ∉ lhs (label (if (b) c⇩1 else c⇩2) 0)" by simp
then show ?case by fastforce
next
case (Proc_CFG_CondThen c⇩1 n et' n' b c⇩2)
note IH = ‹⋀l. ⟦n = Label l; IEdge et = et';
∀V∈rhs (label c⇩1 l). state_val s V = state_val s' V⟧
⟹ ∀V∈lhs (label c⇩1 l). state_val (CFG.transfer (lift_procs wfp) et s) V =
state_val (CFG.transfer (lift_procs wfp) et s') V›
from ‹n ⊕ 1 = Label l› obtain l' where "n = Label l'" and "l = l' + 1"
by(cases n) auto
from ‹c⇩1 ⊢ n -et'→⇩p n'› ‹n = Label l'›
have "l' < #:c⇩1" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
then obtain c' where "labels c⇩1 l' c'" by(erule less_num_inner_nodes_label)
with ‹l = l' + 1› have "labels (if (b) c⇩1 else c⇩2) l c'"
by(fastforce intro:Labels_CondTrue)
with ‹labels c⇩1 l' c'› ‹∀V∈rhs (label (if (b) c⇩1 else c⇩2) l). state_val s V = state_val s' V›
have "∀V∈rhs (label c⇩1 l'). state_val s V = state_val s' V"
by(fastforce dest:labels_label)
with ‹n = Label l'› ‹IEdge et = et'›
have "∀V∈lhs (label c⇩1 l'). state_val (CFG.transfer (lift_procs wfp) et s) V =
state_val (CFG.transfer (lift_procs wfp) et s') V" by (rule IH)
with ‹labels c⇩1 l' c'› ‹labels (if (b) c⇩1 else c⇩2) l c'›
show ?case by(fastforce dest:labels_label)
next
case (Proc_CFG_CondElse c⇩2 n et' n' b c⇩1)
note IH = ‹⋀l. ⟦n = Label l; IEdge et = et';
∀V∈rhs (label c⇩2 l). state_val s V = state_val s' V⟧
⟹ ∀V∈lhs (label c⇩2 l). state_val (CFG.transfer (lift_procs wfp) et s) V =
state_val (CFG.transfer (lift_procs wfp) et s') V›
from ‹n ⊕ #:c⇩1 + 1= Label l› obtain l' where "n = Label l'" and "l = l' + #:c⇩1+1"
by(cases n) auto
from ‹c⇩2 ⊢ n -et'→⇩p n'› ‹n = Label l'›
have "l' < #:c⇩2" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
then obtain c' where "labels c⇩2 l' c'" by(erule less_num_inner_nodes_label)
with ‹l = l' + #:c⇩1 + 1› have "labels (if (b) c⇩1 else c⇩2) l c'"
by(fastforce intro:Labels_CondFalse)
with ‹labels c⇩2 l' c'› ‹∀V∈rhs (label (if (b) c⇩1 else c⇩2) l).
state_val s V = state_val s' V›
have "∀V∈rhs (label c⇩2 l'). state_val s V = state_val s' V"
by(fastforce dest:labels_label)
with ‹n = Label l'› ‹IEdge et = et'›
have "∀V∈lhs (label c⇩2 l'). state_val (CFG.transfer (lift_procs wfp) et s) V =
state_val (CFG.transfer (lift_procs wfp) et s') V" by (rule IH)
with ‹labels c⇩2 l' c'› ‹labels (if (b) c⇩1 else c⇩2) l c'›
show ?case by(fastforce dest:labels_label)
next
case (Proc_CFG_WhileTrue b c')
have "labels (while (b) c') 0 (while (b) c')" by(rule Labels_Base)
hence "label (while (b) c') 0 = while (b) c'" by(rule labels_label)
hence "∀V. V ∉ lhs (label (while (b) c') 0)" by simp
then show ?case by fastforce
next
case (Proc_CFG_WhileFalse b c')
have "labels (while (b) c') 0 (while (b) c')" by(rule Labels_Base)
hence "label (while (b) c') 0 = while (b) c'" by(rule labels_label)
hence "∀V. V ∉ lhs (label (while (b) c') 0)" by simp
then show ?case by fastforce
next
case (Proc_CFG_WhileFalseSkip b c')
have "labels (while (b) c') 1 Skip" by(rule Labels_WhileExit)
hence "label (while (b) c') 1 = Skip" by(rule labels_label)
hence "∀V. V ∉ lhs (label (while (b) c') 1)" by simp
then show ?case by fastforce
next
case (Proc_CFG_WhileBody c' n et' n' b)
note IH = ‹⋀l. ⟦n = Label l; IEdge et = et';
∀V∈rhs (label c' l). state_val s V = state_val s' V⟧
⟹ ∀V∈lhs (label c' l). state_val (CFG.transfer (lift_procs wfp) et s) V =
state_val (CFG.transfer (lift_procs wfp) et s') V›
from ‹n ⊕ 2 = Label l› obtain l' where "n = Label l'" and "l = l' + 2"
by(cases n) auto
from ‹c' ⊢ n -et'→⇩p n'› ‹n = Label l'›
have "l' < #:c'" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
then obtain cx where "labels c' l' cx" by(erule less_num_inner_nodes_label)
with ‹l = l' + 2› have "labels (while (b) c') l (cx;;while (b) c')"
by(fastforce intro:Labels_WhileBody)
with ‹labels c' l' cx› ‹∀V∈rhs (label (while (b) c') l).
state_val s V = state_val s' V›
have "∀V∈rhs (label c' l'). state_val s V = state_val s' V"
by(fastforce dest:labels_label)
with ‹n = Label l'› ‹IEdge et = et'›
have "∀V∈lhs (label c' l'). state_val (CFG.transfer (lift_procs wfp) et s) V =
state_val (CFG.transfer (lift_procs wfp) et s') V" by (rule IH)
with ‹labels c' l' cx› ‹labels (while (b) c') l (cx;;while (b) c')›
show ?case by(fastforce dest:labels_label)
next
case (Proc_CFG_WhileBodyExit c' n et' b)
note IH = ‹⋀l. ⟦n = Label l; IEdge et = et';
∀V∈rhs (label c' l). state_val s V = state_val s' V⟧
⟹ ∀V∈lhs (label c' l). state_val (CFG.transfer (lift_procs wfp) et s) V =
state_val (CFG.transfer (lift_procs wfp) et s') V›
from ‹n ⊕ 2 = Label l› obtain l' where "n = Label l'" and "l = l' + 2"
by(cases n) auto
from ‹c' ⊢ n -et'→⇩p Exit› ‹n = Label l'›
have "l' < #:c'" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
then obtain cx where "labels c' l' cx" by(erule less_num_inner_nodes_label)
with ‹l = l' + 2› have "labels (while (b) c') l (cx;;while (b) c')"
by(fastforce intro:Labels_WhileBody)
with ‹labels c' l' cx› ‹∀V∈rhs (label (while (b) c') l).
state_val s V = state_val s' V›
have "∀V∈rhs (label c' l'). state_val s V = state_val s' V"
by(fastforce dest:labels_label)
with ‹n = Label l'› ‹IEdge et = et'›
have "∀V∈lhs (label c' l'). state_val (CFG.transfer (lift_procs wfp) et s) V =
state_val (CFG.transfer (lift_procs wfp) et s') V" by (rule IH)
with ‹labels c' l' cx› ‹labels (while (b) c') l (cx;;while (b) c')›
show ?case by(fastforce dest:labels_label)
next
case (Proc_CFG_CallSkip p es rets)
have "labels (Call p es rets) 1 Skip" by(rule Labels_Call)
hence "label (Call p es rets) 1 = Skip" by(rule labels_label)
hence "∀V. V ∉ lhs (label (Call p es rets) 1)" by simp
then show ?case by fastforce
qed auto
qed
lemma Proc_CFG_edge_rhs_pred_eq:
assumes "prog ⊢ Label l -IEdge et→⇩p n'" and "CFG.pred et s"
and "∀V∈rhs (label prog l). state_val s V = state_val s' V"
and "length s = length s'"
shows "CFG.pred et s'"
proof -
from ‹prog ⊢ Label l -IEdge et→⇩p n'›
obtain x where "IEdge et = x" and "prog ⊢ Label l -x→⇩p n'" by simp_all
from ‹CFG.pred et s› obtain cf cfs where [simp]:"s = cf#cfs" by(cases s) auto
from ‹length s = length s'› obtain cf' cfs' where [simp]:"s' = cf'#cfs'"
by(cases s') auto
from ‹prog ⊢ Label l -x→⇩p n'› ‹IEdge et = x›
‹∀V∈rhs (label prog l). state_val s V = state_val s' V›
show ?thesis
proof(induct prog "Label l" x n' arbitrary:l rule:Proc_CFG.induct)
case (Proc_CFG_SeqFirst c⇩1 et' n' c⇩2)
note IH = ‹⟦IEdge et = et'; ∀V∈rhs (label c⇩1 l).
state_val s V = state_val s' V⟧ ⟹ CFG.pred et s'›
from ‹c⇩1 ⊢ Label l -et'→⇩p n'›
have "l < #:c⇩1" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
then obtain c' where "labels c⇩1 l c'" by(erule less_num_inner_nodes_label)
hence "labels (c⇩1;;c⇩2) l (c';;c⇩2)" by(rule Labels_Seq1)
with ‹labels c⇩1 l c'› ‹∀V∈rhs (label (c⇩1;; c⇩2) l). state_val s V = state_val s' V›
have "∀V∈rhs (label c⇩1 l). state_val s V = state_val s' V"
by(fastforce dest:labels_label)
with ‹IEdge et = et'› show ?case by (rule IH)
next
case (Proc_CFG_SeqConnect c⇩1 et' c⇩2)
note IH = ‹⟦IEdge et = et';
∀V∈rhs (label c⇩1 l). state_val s V = state_val s' V⟧
⟹ CFG.pred et s'›
from ‹c⇩1 ⊢ Label l -et'→⇩p Exit›
have "l < #:c⇩1" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
then obtain c' where "labels c⇩1 l c'" by(erule less_num_inner_nodes_label)
hence "labels (c⇩1;;c⇩2) l (c';;c⇩2)" by(rule Labels_Seq1)
with ‹labels c⇩1 l c'› ‹∀V∈rhs (label (c⇩1;; c⇩2) l). state_val s V = state_val s' V›
have "∀V∈rhs (label c⇩1 l). state_val s V = state_val s' V"
by(fastforce dest:labels_label)
with ‹IEdge et = et'› show ?case by (rule IH)
next
case (Proc_CFG_SeqSecond c⇩2 n et' n' c⇩1)
note IH = ‹⋀l. ⟦n = Label l; IEdge et = et';
∀V∈rhs (label c⇩2 l). state_val s V = state_val s' V⟧
⟹ CFG.pred et s'›
from ‹n ⊕ #:c⇩1 = Label l› obtain l' where "n = Label l'" and "l = l' + #:c⇩1"
by(cases n) auto
from ‹c⇩2 ⊢ n -et'→⇩p n'› ‹n = Label l'›
have "l' < #:c⇩2" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
then obtain c' where "labels c⇩2 l' c'" by(erule less_num_inner_nodes_label)
with ‹l = l' + #:c⇩1› have "labels (c⇩1;;c⇩2) l c'" by(fastforce intro:Labels_Seq2)
with ‹labels c⇩2 l' c'› ‹∀V∈rhs (label (c⇩1;;c⇩2) l). state_val s V = state_val s' V›
have "∀V∈rhs (label c⇩2 l'). state_val s V = state_val s' V"
by(fastforce dest:labels_label)
with ‹n = Label l'› ‹IEdge et = et'› show ?case by (rule IH)
next
case (Proc_CFG_CondTrue b c⇩1 c⇩2)
from ‹CFG.pred et s› ‹IEdge et = IEdge (λcf. state_check cf b (Some true))⇩√›
have "state_check (fst cf) b (Some true)" by simp
moreover
have "labels (if (b) c⇩1 else c⇩2) 0 (if (b) c⇩1 else c⇩2)" by(rule Labels_Base)
hence "label (if (b) c⇩1 else c⇩2) 0 = if (b) c⇩1 else c⇩2" by(rule labels_label)
with ‹∀V∈rhs (label (if (b) c⇩1 else c⇩2) 0). state_val s V = state_val s' V›
have "∀V∈ fv b. state_val s V = state_val s' V" by fastforce
ultimately have "state_check (fst cf') b (Some true)"
by simp(rule rhs_interpret_eq)
with ‹IEdge et = IEdge (λcf. state_check cf b (Some true))⇩√›
show ?case by simp
next
case (Proc_CFG_CondFalse b c⇩1 c⇩2)
from ‹CFG.pred et s›
‹IEdge et = IEdge (λcf. state_check cf b (Some false))⇩√›
have "state_check (fst cf) b (Some false)" by simp
moreover
have "labels (if (b) c⇩1 else c⇩2) 0 (if (b) c⇩1 else c⇩2)" by(rule Labels_Base)
hence "label (if (b) c⇩1 else c⇩2) 0 = if (b) c⇩1 else c⇩2" by(rule labels_label)
with ‹∀V∈rhs (label (if (b) c⇩1 else c⇩2) 0). state_val s V = state_val s' V›
have "∀V∈ fv b. state_val s V = state_val s' V" by fastforce
ultimately have "state_check (fst cf') b (Some false)"
by simp(rule rhs_interpret_eq)
with ‹IEdge et = IEdge (λcf. state_check cf b (Some false))⇩√›
show ?case by simp
next
case (Proc_CFG_CondThen c⇩1 n et' n' b c⇩2)
note IH = ‹⋀l. ⟦n = Label l; IEdge et = et';
∀V∈rhs (label c⇩1 l). state_val s V = state_val s' V⟧
⟹ CFG.pred et s'›
from ‹n ⊕ 1 = Label l› obtain l' where "n = Label l'" and "l = l' + 1"
by(cases n) auto
from ‹c⇩1 ⊢ n -et'→⇩p n'› ‹n = Label l'›
have "l' < #:c⇩1" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
then obtain c' where "labels c⇩1 l' c'" by(erule less_num_inner_nodes_label)
with ‹l = l' + 1› have "labels (if (b) c⇩1 else c⇩2) l c'"
by(fastforce intro:Labels_CondTrue)
with ‹labels c⇩1 l' c'› ‹∀V∈rhs (label (if (b) c⇩1 else c⇩2) l).
state_val s V = state_val s' V›
have "∀V∈rhs (label c⇩1 l'). state_val s V = state_val s' V"
by(fastforce dest:labels_label)
with ‹n = Label l'› ‹IEdge et = et'› show ?case by (rule IH)
next
case (Proc_CFG_CondElse c⇩2 n et' n' b c⇩1)
note IH = ‹⋀l. ⟦n = Label l; IEdge et = et';
∀V∈rhs (label c⇩2 l). state_val s V = state_val s' V⟧
⟹ CFG.pred et s'›
from ‹n ⊕ #:c⇩1 + 1= Label l› obtain l' where "n = Label l'" and "l = l' + #:c⇩1+1"
by(cases n) auto
from ‹c⇩2 ⊢ n -et'→⇩p n'› ‹n = Label l'›
have "l' < #:c⇩2" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
then obtain c' where "labels c⇩2 l' c'" by(erule less_num_inner_nodes_label)
with ‹l = l' + #:c⇩1 + 1› have "labels (if (b) c⇩1 else c⇩2) l c'"
by(fastforce intro:Labels_CondFalse)
with ‹labels c⇩2 l' c'› ‹∀V∈rhs (label (if (b) c⇩1 else c⇩2) l).
state_val s V = state_val s' V›
have "∀V∈rhs (label c⇩2 l'). state_val s V = state_val s' V"
by(fastforce dest:labels_label)
with ‹n = Label l'› ‹IEdge et = et'› show ?case by (rule IH)
next
case (Proc_CFG_WhileTrue b c')
from ‹CFG.pred et s› ‹IEdge et = IEdge (λcf. state_check cf b (Some true))⇩√›
have "state_check (fst cf) b (Some true)" by simp
moreover
have "labels (while (b) c') 0 (while (b) c')" by(rule Labels_Base)
hence "label (while (b) c') 0 = while (b) c'" by(rule labels_label)
with ‹∀V∈rhs (label (while (b) c') 0). state_val s V = state_val s' V›
have "∀V∈ fv b. state_val s V = state_val s' V" by fastforce
ultimately have "state_check (fst cf') b (Some true)"
by simp(rule rhs_interpret_eq)
with ‹IEdge et = IEdge (λcf. state_check cf b (Some true))⇩√›
show ?case by simp
next
case (Proc_CFG_WhileFalse b c')
from ‹CFG.pred et s›
‹IEdge et = IEdge (λcf. state_check cf b (Some false))⇩√›
have "state_check (fst cf) b (Some false)" by simp
moreover
have "labels (while (b) c') 0 (while (b) c')" by(rule Labels_Base)
hence "label (while (b) c') 0 = while (b) c'" by(rule labels_label)
with ‹∀V∈rhs (label (while (b) c') 0). state_val s V = state_val s' V›
have "∀V∈ fv b. state_val s V = state_val s' V" by fastforce
ultimately have "state_check (fst cf') b (Some false)"
by simp(rule rhs_interpret_eq)
with ‹IEdge et = IEdge (λcf. state_check cf b (Some false))⇩√›
show ?case by simp
next
case (Proc_CFG_WhileBody c' n et' n' b)
note IH = ‹⋀l. ⟦n = Label l; IEdge et = et';
∀V∈rhs (label c' l). state_val s V = state_val s' V⟧
⟹ CFG.pred et s'›
from ‹n ⊕ 2 = Label l› obtain l' where "n = Label l'" and "l = l' + 2"
by(cases n) auto
from ‹c' ⊢ n -et'→⇩p n'› ‹n = Label l'›
have "l' < #:c'" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
then obtain cx where "labels c' l' cx" by(erule less_num_inner_nodes_label)
with ‹l = l' + 2› have "labels (while (b) c') l (cx;;while (b) c')"
by(fastforce intro:Labels_WhileBody)
with ‹labels c' l' cx› ‹∀V∈rhs (label (while (b) c') l).
state_val s V = state_val s' V›
have "∀V∈rhs (label c' l'). state_val s V = state_val s' V"
by(fastforce dest:labels_label)
with ‹n = Label l'› ‹IEdge et = et'› show ?case by (rule IH)
next
case (Proc_CFG_WhileBodyExit c' n et' b)
note IH = ‹⋀l. ⟦n = Label l; IEdge et = et';
∀V∈rhs (label c' l). state_val s V = state_val s' V⟧
⟹ CFG.pred et s'›
from ‹n ⊕ 2 = Label l› obtain l' where "n = Label l'" and "l = l' + 2"
by(cases n) auto
from ‹c' ⊢ n -et'→⇩p Exit› ‹n = Label l'›
have "l' < #:c'" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
then obtain cx where "labels c' l' cx" by(erule less_num_inner_nodes_label)
with ‹l = l' + 2› have "labels (while (b) c') l (cx;;while (b) c')"
by(fastforce intro:Labels_WhileBody)
with ‹labels c' l' cx› ‹∀V∈rhs (label (while (b) c') l).
state_val s V = state_val s' V›
have "∀V∈rhs (label c' l'). state_val s V = state_val s' V"
by(fastforce dest:labels_label)
with ‹n = Label l'› ‹IEdge et = et'› show ?case by (rule IH)
qed auto
qed
subsection ‹Instantiating the ‹CFG_wf› locale›
interpretation ProcCFG_wf:
CFG_wf sourcenode targetnode kind "valid_edge wfp" "(Main,Entry)"
get_proc "get_return_edges wfp" "lift_procs wfp" Main
"Def wfp" "Use wfp" "ParamDefs wfp" "ParamUses wfp"
for wfp
proof -
from Rep_wf_prog[of wfp]
obtain prog procs where [simp]:"Rep_wf_prog wfp = (prog,procs)"
by(fastforce simp:wf_prog_def)
hence "wf prog procs" by(rule wf_wf_prog)
hence wf:"well_formed procs" by fastforce
show "CFG_wf sourcenode targetnode kind (valid_edge wfp)
(Main, Entry) get_proc (get_return_edges wfp) (lift_procs wfp) Main
(Def wfp) (Use wfp) (ParamDefs wfp) (ParamUses wfp)"
proof
from Entry_Def_empty Entry_Use_empty
show "Def wfp (Main, Entry) = {} ∧ Use wfp (Main, Entry) = {}" by simp
next
fix a Q r p fs ins outs
assume "valid_edge wfp a" and "kind a = Q:r↪⇘p⇙fs"
and "(p, ins, outs) ∈ set (lift_procs wfp)"
hence "prog,procs ⊢ sourcenode a -kind a→ targetnode a"
by(simp add:valid_edge_def)
from this ‹kind a = Q:r↪⇘p⇙fs› ‹(p, ins, outs) ∈ set (lift_procs wfp)›
show "length (ParamUses wfp (sourcenode a)) = length ins"
proof(induct n≡"sourcenode a" et≡"kind a" n'≡"targetnode a" rule:PCFG.induct)
case (MainCall l p' es rets n' insx outsx cx)
with wf have [simp]:"insx = ins" by fastforce
from ‹prog ⊢ Label l -CEdge (p', es, rets)→⇩p n'›
have "containsCall procs prog [] p'" by(rule Proc_CFG_Call_containsCall)
with ‹wf prog procs› ‹(p', insx, outsx, cx) ∈ set procs›
‹prog ⊢ Label l -CEdge (p', es, rets)→⇩p n'›
have "length es = length ins" by fastforce
from ‹prog ⊢ Label l -CEdge (p', es, rets)→⇩p n'›
have "ParamUses wfp (Main, Label l) = map fv es"
by(fastforce intro:ParamUses_Main_Return_target)
with ‹(Main, Label l) = sourcenode a› ‹length es = length ins›
show ?case by simp
next
case (ProcCall px insx outsx cx l p' es rets l' ins' outs' c' ps)
with wf have [simp]:"ins' = ins" by fastforce
from ‹cx ⊢ Label l -CEdge (p', es, rets)→⇩p Label l'›
have "containsCall procs cx [] p'" by(rule Proc_CFG_Call_containsCall)
with ‹containsCall procs prog ps px› ‹(px, insx, outsx, cx) ∈ set procs›
have "containsCall procs prog (ps@[px]) p'" by(rule containsCall_in_proc)
with ‹wf prog procs› ‹(p', ins', outs', c') ∈ set procs›
‹cx ⊢ Label l -CEdge (p', es, rets)→⇩p Label l'›
have "length es = length ins" by fastforce
from ‹(px, insx, outsx, cx) ∈ set procs›
‹cx ⊢ Label l -CEdge (p', es, rets)→⇩p Label l'›
have "ParamUses wfp (px,Label l) = map fv es"
by(fastforce intro:ParamUses_Proc_Return_target simp:set_conv_nth)
with ‹(px, Label l) = sourcenode a› ‹length es = length ins›
show ?case by simp
qed auto
next
fix a assume "valid_edge wfp a"
hence "prog,procs ⊢ sourcenode a -kind a→ targetnode a"
by(simp add:valid_edge_def)
thus "distinct (ParamDefs wfp (targetnode a))"
proof(induct "sourcenode a" "kind a" "targetnode a" rule:PCFG.induct)
case (Main n n')
from ‹prog ⊢ n -IEdge (kind a)→⇩p n'› ‹(Main, n') = targetnode a›
have "ParamDefs wfp (Main,n') = []" by(fastforce intro:ParamDefs_Main_IEdge_Nil)
with ‹(Main, n') = targetnode a› show ?case by simp
next
case (Proc p ins outs c n n')
from ‹(p, ins, outs, c) ∈ set procs› ‹c ⊢ n -IEdge (kind a)→⇩p n'›
have "ParamDefs wfp (p,n') = []" by(fastforce intro:ParamDefs_Proc_IEdge_Nil)
with ‹(p, n') = targetnode a› show ?case by simp
next
case (MainCall l p es rets n' ins outs c)
with ‹(p, ins, outs, c) ∈ set procs› wf have [simp]:"p ≠ Main"
by fastforce
from wf ‹(p, ins, outs, c) ∈ set procs›
have "(THE c'. ∃ins' outs'. (p,ins',outs',c') ∈ set procs) = c"
by(rule in_procs_THE_in_procs_cmd)
with ‹(p, Entry) = targetnode a›[THEN sym] show ?case
by(auto simp:ParamDefs_def ParamDefs_proc_def)
next
case (ProcCall p ins outs c l p' es' rets' l' ins' outs' c')
with ‹(p', ins', outs', c') ∈ set procs› wf
have [simp]:"p' ≠ Main" by fastforce
from wf ‹(p', ins', outs', c') ∈ set procs›
have "(THE cx. ∃insx outsx. (p',insx,outsx,cx) ∈ set procs) = c'"
by(rule in_procs_THE_in_procs_cmd)
with ‹(p', Entry) = targetnode a›[THEN sym] show ?case
by(fastforce simp:ParamDefs_def ParamDefs_proc_def)
next
case (MainReturn l p es rets l' ins outs c)
from ‹prog ⊢ Label l -CEdge (p, es, rets)→⇩p Label l'›
have "containsCall procs prog [] p" by(rule Proc_CFG_Call_containsCall)
with ‹wf prog procs› ‹(p, ins, outs, c) ∈ set procs›
‹prog ⊢ Label l -CEdge (p, es, rets)→⇩p Label l'›
have "distinct rets" by fastforce
from ‹prog ⊢ Label l -CEdge (p, es, rets)→⇩p Label l'›
have "ParamDefs wfp (Main,Label l') = rets"
by(fastforce intro:ParamDefs_Main_Return_target)
with ‹distinct rets› ‹(Main, Label l') = targetnode a› show ?case
by(fastforce simp:distinct_map inj_on_def)
next
case (ProcReturn p ins outs c l p' es' rets' l' ins' outs' c' ps)
from ‹c ⊢ Label l -CEdge (p', es', rets')→⇩p Label l'›
have "containsCall procs c [] p'" by(rule Proc_CFG_Call_containsCall)
with ‹containsCall procs prog ps p› ‹(p, ins, outs, c) ∈ set procs›
have "containsCall procs prog (ps@[p]) p'" by(rule containsCall_in_proc)
with ‹wf prog procs› ‹(p', ins', outs', c') ∈ set procs›
‹c ⊢ Label l -CEdge (p', es', rets')→⇩p Label l'›
have "distinct rets'" by fastforce
from ‹(p, ins, outs, c) ∈ set procs›
‹c ⊢ Label l -CEdge (p', es', rets')→⇩p Label l'›
have "ParamDefs wfp (p,Label l') = rets'"
by(fastforce intro:ParamDefs_Proc_Return_target simp:set_conv_nth)
with ‹distinct rets'› ‹(p, Label l') = targetnode a› show ?case
by(fastforce simp:distinct_map inj_on_def)
next
case (MainCallReturn n p es rets n')
from ‹prog ⊢ n -CEdge (p, es, rets)→⇩p n'›
have "containsCall procs prog [] p" by(rule Proc_CFG_Call_containsCall)
with ‹wf prog procs› obtain ins outs c where "(p, ins, outs, c) ∈ set procs"
by(simp add:wf_def) blast
with ‹wf prog procs› ‹containsCall procs prog [] p›
‹prog ⊢ n -CEdge (p, es, rets)→⇩p n'›
have "distinct rets" by fastforce
from ‹prog ⊢ n -CEdge (p, es, rets)→⇩p n'›
have "ParamDefs wfp (Main,n') = rets"
by(fastforce intro:ParamDefs_Main_Return_target)
with ‹distinct rets› ‹(Main, n') = targetnode a› show ?case
by(fastforce simp:distinct_map inj_on_def)
next
case (ProcCallReturn p ins outs c n p' es' rets' n' ps)
from ‹c ⊢ n -CEdge (p', es', rets')→⇩p n'›
have "containsCall procs c [] p'" by(rule Proc_CFG_Call_containsCall)
from ‹Rep_wf_prog wfp = (prog,procs)› ‹(p, ins, outs, c) ∈ set procs›
‹containsCall procs prog ps p›
obtain wfp' where "Rep_wf_prog wfp' = (c,procs)" by(erule wfp_Call)
hence "wf c procs" by(rule wf_wf_prog)
with ‹containsCall procs c [] p'› obtain ins' outs' c'
where "(p', ins', outs', c') ∈ set procs"
by(simp add:wf_def) blast
from ‹containsCall procs prog ps p› ‹(p, ins, outs, c) ∈ set procs›
‹containsCall procs c [] p'›
have "containsCall procs prog (ps@[p]) p'" by(rule containsCall_in_proc)
with ‹wf prog procs› ‹(p', ins', outs', c') ∈ set procs›
‹c ⊢ n -CEdge (p', es', rets')→⇩p n'›
have "distinct rets'" by fastforce
from ‹(p, ins, outs, c) ∈ set procs› ‹c ⊢ n -CEdge (p', es', rets')→⇩p n'›
have "ParamDefs wfp (p,n') = rets'"
by(fastforce intro:ParamDefs_Proc_Return_target)
with ‹distinct rets'› ‹(p, n') = targetnode a› show ?case
by(fastforce simp:distinct_map inj_on_def)
qed
next
fix a Q' p f' ins outs
assume "valid_edge wfp a" and "kind a = Q'↩⇘p⇙f'"
and "(p, ins, outs) ∈ set (lift_procs wfp)"
thus "length (ParamDefs wfp (targetnode a)) = length outs"
by(rule ParamDefs_length)
next
fix n V assume "CFG.valid_node sourcenode targetnode (valid_edge wfp) n"
and "V ∈ set (ParamDefs wfp n)"
thus "V ∈ Def wfp n" by(simp add:Def_def)
next
fix a Q r p fs ins outs V
assume "valid_edge wfp a" and "kind a = Q:r↪⇘p⇙fs"
and "(p, ins, outs) ∈ set (lift_procs wfp)" and "V ∈ set ins"
hence "prog,procs ⊢ sourcenode a -kind a→ targetnode a"
by(simp add:valid_edge_def)
from this ‹kind a = Q:r↪⇘p⇙fs› ‹(p, ins, outs) ∈ set (lift_procs wfp)› ‹V ∈ set ins›
show "V ∈ Def wfp (targetnode a)"
proof(induct n≡"sourcenode a" et≡"kind a" n'≡"targetnode a" rule:PCFG.induct)
case (MainCall l p' es rets n' insx outsx cx)
with wf have [simp]:"insx = ins" by fastforce
from wf ‹(p', insx, outsx, cx) ∈ set procs›
have "(THE ins'. ∃c' outs'. (p',ins',outs',c') ∈ set procs) =
insx" by(rule in_procs_THE_in_procs_ins)
with ‹(p', Entry) = targetnode a›[THEN sym] ‹V ∈ set ins›
‹(p', insx, outsx, cx) ∈ set procs› show ?case by(auto simp:Def_def)
next
case (ProcCall px insx outsx cx l p' es rets l' ins' outs' c')
with wf have [simp]:"ins' = ins" by fastforce
from wf ‹(p', ins', outs', c') ∈ set procs›
have "(THE insx. ∃cx outsx. (p',insx,outsx,cx) ∈ set procs) =
ins'" by(rule in_procs_THE_in_procs_ins)
with ‹(p', Entry) = targetnode a›[THEN sym] ‹V ∈ set ins›
‹(p', ins', outs', c') ∈ set procs› show ?case by(auto simp:Def_def)
qed auto
next
fix a Q r p fs
assume "valid_edge wfp a" and "kind a = Q:r↪⇘p⇙fs"
hence "prog,procs ⊢ sourcenode a -kind a→ targetnode a"
by(simp add:valid_edge_def)
from this ‹kind a = Q:r↪⇘p⇙fs› show "Def wfp (sourcenode a) = {}"
proof(induct n≡"sourcenode a" et≡"kind a" n'≡"targetnode a" rule:PCFG.induct)
case (MainCall l p' es rets n' insx outsx cx)
from ‹(Main, Label l) = sourcenode a›[THEN sym]
‹prog ⊢ Label l -CEdge (p', es, rets)→⇩p n'›
have "ParamDefs wfp (sourcenode a) = []"
by(fastforce intro:ParamDefs_Main_CEdge_Nil)
with ‹prog ⊢ Label l -CEdge (p', es, rets)→⇩p n'›
‹(Main, Label l) = sourcenode a›[THEN sym]
show ?case by(fastforce dest:Proc_CFG_Call_source_empty_lhs simp:Def_def)
next
case (ProcCall px insx outsx cx l p' es' rets' l' ins' outs' c')
from ‹(px, insx, outsx, cx) ∈ set procs› wf
have [simp]:"px ≠ Main" by fastforce
from ‹cx ⊢ Label l -CEdge (p', es', rets')→⇩p Label l'›
have "lhs (label cx l) = {}" by(rule Proc_CFG_Call_source_empty_lhs)
from wf ‹(px, insx, outsx, cx) ∈ set procs›
have THE:"(THE c'. ∃ins' outs'. (px,ins',outs',c') ∈ set procs) = cx"
by(rule in_procs_THE_in_procs_cmd)
with ‹(px, Label l) = sourcenode a›[THEN sym]
‹cx ⊢ Label l -CEdge (p', es', rets')→⇩p Label l'› wf
have "ParamDefs wfp (sourcenode a) = []"
by(fastforce dest:Proc_CFG_Call_targetnode_no_Call_sourcenode
[of _ _ _ _ _ "Label l"] simp:ParamDefs_def ParamDefs_proc_def)
with ‹(px, Label l) = sourcenode a›[THEN sym] ‹lhs (label cx l) = {}› THE
show ?case by(auto simp:Def_def)
qed auto
next
fix n V assume "CFG.valid_node sourcenode targetnode (valid_edge wfp) n"
and "V ∈ ⋃(set (ParamUses wfp n))"
thus "V ∈ Use wfp n" by(fastforce simp:Use_def)
next
fix a Q p f ins outs V
assume "valid_edge wfp a" and "kind a = Q↩⇘p⇙f"
and "(p, ins, outs) ∈ set (lift_procs wfp)" and "V ∈ set outs"
hence "prog,procs ⊢ sourcenode a -kind a→ targetnode a"
by(simp add:valid_edge_def)
from this ‹kind a = Q↩⇘p⇙f› ‹(p, ins, outs) ∈ set (lift_procs wfp)› ‹V ∈ set outs›
show "V ∈ Use wfp (sourcenode a)"
proof(induct "sourcenode a" "kind a" "targetnode a" rule:PCFG.induct)
case (MainReturn l p' es rets l' insx outsx cx)
with wf have [simp]:"outsx = outs" by fastforce
from wf ‹(p', insx, outsx, cx) ∈ set procs›
have "(THE outs'. ∃c' ins'. (p',ins',outs',c') ∈ set procs) =
outsx" by(rule in_procs_THE_in_procs_outs)
with ‹(p', Exit) = sourcenode a›[THEN sym] ‹V ∈ set outs›
‹(p', insx, outsx, cx) ∈ set procs› show ?case by(auto simp:Use_def)
next
case (ProcReturn px insx outsx cx l p' es' rets' l' ins' outs' c')
with wf have [simp]:"outs' = outs" by fastforce
from wf ‹(p', ins', outs', c') ∈ set procs›
have "(THE outsx. ∃cx insx. (p',insx,outsx,cx) ∈ set procs) =
outs'" by(rule in_procs_THE_in_procs_outs)
with ‹(p', Exit) = sourcenode a›[THEN sym] ‹V ∈ set outs›
‹(p', ins', outs', c') ∈ set procs› show ?case by(auto simp:Use_def)
qed auto
next
fix a V s
assume "valid_edge wfp a" and "V ∉ Def wfp (sourcenode a)"
and "intra_kind (kind a)" and "CFG.pred (kind a) s"
hence "prog,procs ⊢ sourcenode a -kind a→ targetnode a"
by(simp add:valid_edge_def)
from this ‹V ∉ Def wfp (sourcenode a)› ‹intra_kind (kind a)› ‹CFG.pred (kind a) s›
show "state_val (CFG.transfer (lift_procs wfp) (kind a) s) V = state_val s V"
proof(induct "sourcenode a" "kind a" "targetnode a" rule:PCFG.induct)
case (Main n n')
from ‹CFG.pred (kind a) s› obtain cf cfs where "s = cf#cfs" by(cases s) auto
show ?case
proof(cases n)
case (Label l)
with ‹V ∉ Def wfp (sourcenode a)› ‹(Main, n) = sourcenode a›
have "V ∉ lhs (label prog l)" by(fastforce simp:Def_def)
with ‹prog ⊢ n -IEdge (kind a)→⇩p n'› ‹n = Label l›
have "state_val (CFG.transfer (lift_procs wfp) (kind a) (cf#cfs)) V = fst cf V"
by(fastforce intro:Proc_CFG_edge_no_lhs_equal)
with ‹s = cf#cfs› show ?thesis by simp
next
case Entry
with ‹prog ⊢ n -IEdge (kind a)→⇩p n'› ‹s = cf#cfs›
show ?thesis
by(fastforce dest:Proc_CFG_EntryD simp:transfers_simps[of wfp,simplified])
next
case Exit
with ‹prog ⊢ n -IEdge (kind a)→⇩p n'› have False by fastforce
thus ?thesis by simp
qed
next
case (Proc p ins outs c n n')
from ‹CFG.pred (kind a) s› obtain cf cfs where "s = cf#cfs" by(cases s) auto
from wf ‹(p, ins, outs, c) ∈ set procs›
have THE1:"(THE ins'. ∃c' outs'. (p,ins',outs',c') ∈ set procs) = ins"
by(rule in_procs_THE_in_procs_ins)
from wf ‹(p, ins, outs, c) ∈ set procs›
have THE2:"(THE c'. ∃ins' outs'. (p,ins',outs',c') ∈ set procs) = c"
by(rule in_procs_THE_in_procs_cmd)
from wf ‹(p, ins, outs, c) ∈ set procs›
have [simp]:"p ≠ Main" by fastforce
show ?case
proof(cases n)
case (Label l)
with ‹V ∉ Def wfp (sourcenode a)› ‹(p, n) = sourcenode a›
‹(p, ins, outs, c) ∈ set procs› wf THE1 THE2
have "V ∉ lhs (label c l)" by(fastforce simp:Def_def split:if_split_asm)
with ‹c ⊢ n -IEdge (kind a)→⇩p n'› ‹n = Label l›
have "state_val (CFG.transfer (lift_procs wfp) (kind a) (cf#cfs)) V = fst cf V"
by(fastforce intro:Proc_CFG_edge_no_lhs_equal)
with ‹s = cf#cfs› show ?thesis by simp
next
case Entry
with ‹c ⊢ n -IEdge (kind a)→⇩p n'› ‹s = cf#cfs›
show ?thesis
by(fastforce dest:Proc_CFG_EntryD simp:transfers_simps[of wfp,simplified])
next
case Exit
with ‹c ⊢ n -IEdge (kind a)→⇩p n'› have False by fastforce
thus ?thesis by simp
qed
next
case MainCallReturn thus ?case by(cases s,auto simp:intra_kind_def)
next
case ProcCallReturn thus ?case by(cases s,auto simp:intra_kind_def)
qed(auto simp:intra_kind_def)
next
fix a s s'
assume "valid_edge wfp a"
and "∀V∈Use wfp (sourcenode a). state_val s V = state_val s' V"
and "intra_kind (kind a)" and "CFG.pred (kind a) s" and "CFG.pred (kind a) s'"
hence "prog,procs ⊢ sourcenode a -kind a→ targetnode a"
by(simp add:valid_edge_def)
from ‹CFG.pred (kind a) s› obtain cf cfs where [simp]:"s = cf#cfs"
by(cases s) auto
from ‹CFG.pred (kind a) s'› obtain cf' cfs' where [simp]:"s' = cf'#cfs'"
by(cases s') auto
from ‹prog,procs ⊢ sourcenode a -kind a→ targetnode a› ‹intra_kind (kind a)›
‹∀V∈Use wfp (sourcenode a). state_val s V = state_val s' V›
‹CFG.pred (kind a) s› ‹CFG.pred (kind a) s'›
show "∀V∈Def wfp (sourcenode a).
state_val (CFG.transfer (lift_procs wfp) (kind a) s) V =
state_val (CFG.transfer (lift_procs wfp) (kind a) s') V"
proof(induct "sourcenode a" "kind a" "targetnode a" rule:PCFG.induct)
case (Main n n')
show ?case
proof(cases n)
case (Label l)
with ‹∀V∈Use wfp (sourcenode a). state_val s V = state_val s' V›
‹(Main, n) = sourcenode a›[THEN sym]
have rhs:"∀V∈rhs (label prog l). state_val s V = state_val s' V"
and PDef:"∀V∈set (ParamDefs wfp (sourcenode a)).
state_val s V = state_val s' V"
by(auto simp:Use_def)
from rhs ‹prog ⊢ n -IEdge (kind a)→⇩p n'› ‹n = Label l› ‹CFG.pred (kind a) s›
‹CFG.pred (kind a) s'›
have lhs:"∀V∈lhs (label prog l).
state_val (CFG.transfer (lift_procs wfp) (kind a) s) V =
state_val (CFG.transfer (lift_procs wfp) (kind a) s') V"
by -(rule Proc_CFG_edge_uses_only_rhs,auto)
from PDef ‹prog ⊢ n -IEdge (kind a)→⇩p n'› ‹(Main, n) = sourcenode a›[THEN sym]
have "∀V∈set (ParamDefs wfp (sourcenode a)).
state_val (CFG.transfer (lift_procs wfp) (kind a) s) V =
state_val (CFG.transfer (lift_procs wfp) (kind a) s') V"
by(fastforce dest:Proc_CFG_Call_follows_id_edge
simp:ParamDefs_def ParamDefs_proc_def transfers_simps[of wfp,simplified]
split:if_split_asm)
with lhs ‹(Main, n) = sourcenode a›[THEN sym] Label show ?thesis
by(fastforce simp:Def_def)
next
case Entry
with ‹(Main, n) = sourcenode a›[THEN sym]
show ?thesis by(fastforce simp:Entry_Def_empty)
next
case Exit
with ‹prog ⊢ n -IEdge (kind a)→⇩p n'› have False by fastforce
thus ?thesis by simp
qed
next
case (Proc p ins outs c n n')
show ?case
proof(cases n)
case (Label l)
with ‹∀V∈Use wfp (sourcenode a). state_val s V = state_val s' V› wf
‹(p, n) = sourcenode a›[THEN sym] ‹(p, ins, outs, c) ∈ set procs›
have rhs:"∀V∈rhs (label c l). state_val s V = state_val s' V"
and PDef:"∀V∈set (ParamDefs wfp (sourcenode a)).
state_val s V = state_val s' V"
by(auto dest:in_procs_THE_in_procs_cmd simp:Use_def split:if_split_asm)
from rhs ‹c ⊢ n -IEdge (kind a)→⇩p n'› ‹n = Label l› ‹CFG.pred (kind a) s›
‹CFG.pred (kind a) s'›
have lhs:"∀V∈lhs (label c l).
state_val (CFG.transfer (lift_procs wfp) (kind a) s) V =
state_val (CFG.transfer (lift_procs wfp) (kind a) s') V"
by -(rule Proc_CFG_edge_uses_only_rhs,auto)
from ‹(p, ins, outs, c) ∈ set procs› wf have [simp]:"p ≠ Main" by fastforce
from wf ‹(p, ins, outs, c) ∈ set procs›
have THE:"(THE c'. ∃ins' outs'. (p,ins',outs',c') ∈ set procs) = c"
by(fastforce intro:in_procs_THE_in_procs_cmd)
with PDef ‹c ⊢ n -IEdge (kind a)→⇩p n'› ‹(p, n) = sourcenode a›[THEN sym]
have "∀V∈set (ParamDefs wfp (sourcenode a)).
state_val (CFG.transfer (lift_procs wfp) (kind a) s) V =
state_val (CFG.transfer (lift_procs wfp) (kind a) s') V"
by(fastforce dest:Proc_CFG_Call_follows_id_edge
simp:ParamDefs_def ParamDefs_proc_def transfers_simps[of wfp,simplified]
split:if_split_asm)
with lhs ‹(p, n) = sourcenode a›[THEN sym] Label THE
show ?thesis by(auto simp:Def_def)
next
case Entry
with wf ‹(p, ins, outs, c) ∈ set procs› have "ParamDefs wfp (p,n) = []"
by(fastforce simp:ParamDefs_def ParamDefs_proc_def)
moreover
from Entry ‹c ⊢ n -IEdge (kind a)→⇩p n'› ‹(p, ins, outs, c) ∈ set procs›
have "ParamUses wfp (p,n) = []" by(fastforce intro:ParamUses_Proc_IEdge_Nil)
ultimately have "∀V∈set ins. state_val s V = state_val s' V"
using wf ‹(p, ins, outs, c) ∈ set procs› ‹(p,n) = sourcenode a›
‹∀V∈Use wfp (sourcenode a). state_val s V = state_val s' V› Entry
by(fastforce dest:in_procs_THE_in_procs_ins simp:Use_def split:if_split_asm)
with ‹c ⊢ n -IEdge (kind a)→⇩p n'› Entry
have "∀V∈set ins. state_val (CFG.transfer (lift_procs wfp) (kind a) s) V =
state_val (CFG.transfer (lift_procs wfp) (kind a) s') V"
by(fastforce dest:Proc_CFG_EntryD simp:transfers_simps[of wfp,simplified])
with ‹(p,n) = sourcenode a›[THEN sym] Entry wf
‹(p, ins, outs, c) ∈ set procs› ‹ParamDefs wfp (p,n) = []›
show ?thesis by(auto dest:in_procs_THE_in_procs_ins simp:Def_def)
next
case Exit
with ‹c ⊢ n -IEdge (kind a)→⇩p n'› have False by fastforce
thus ?thesis by simp
qed
qed(auto simp:intra_kind_def)
next
fix a s fix s'::"((char list ⇀ val) × node) list"
assume "valid_edge wfp a" and "CFG.pred (kind a) s"
and "∀V∈Use wfp (sourcenode a). state_val s V = state_val s' V"
and "length s = length s'" and "snd (hd s) = snd (hd s')"
hence "prog,procs ⊢ sourcenode a -kind a→ targetnode a"
by(simp add:valid_edge_def)
from ‹CFG.pred (kind a) s› obtain cf cfs where [simp]:"s = cf#cfs"
by(cases s) auto
from ‹length s = length s'› obtain cf' cfs' where [simp]:"s' = cf'#cfs'"
by(cases s') auto
from ‹prog,procs ⊢ sourcenode a -kind a→ targetnode a› ‹CFG.pred (kind a) s›
‹∀V∈Use wfp (sourcenode a). state_val s V = state_val s' V›
‹length s = length s'› ‹snd (hd s) = snd (hd s')›
show "CFG.pred (kind a) s'"
proof(induct "sourcenode a" "kind a" "targetnode a" rule:PCFG.induct)
case (Main n n')
show ?case
proof(cases n)
case (Label l)
with ‹∀V∈Use wfp (sourcenode a). state_val s V = state_val s' V›
‹(Main, n) = sourcenode a›
have "∀V∈rhs (label prog l). state_val s V = state_val s' V"
by(fastforce simp:Use_def)
with ‹prog ⊢ n -IEdge (kind a)→⇩p n'› Label ‹CFG.pred (kind a) s›
‹length s = length s'›
show ?thesis by(fastforce intro:Proc_CFG_edge_rhs_pred_eq)
next
case Entry
with ‹prog ⊢ n -IEdge (kind a)→⇩p n'› ‹CFG.pred (kind a) s›
show ?thesis by(fastforce dest:Proc_CFG_EntryD)
next
case Exit
with ‹prog ⊢ n -IEdge (kind a)→⇩p n'› have False by fastforce
thus ?thesis by simp
qed
next
case (Proc p ins outs c n n')
show ?case
proof(cases n)
case (Label l)
with ‹∀V∈Use wfp (sourcenode a). state_val s V = state_val s' V› wf
‹(p, n) = sourcenode a›[THEN sym] ‹(p, ins, outs, c) ∈ set procs›
have "∀V∈rhs (label c l). state_val s V = state_val s' V"
by(auto dest:in_procs_THE_in_procs_cmd simp:Use_def split:if_split_asm)
with ‹c ⊢ n -IEdge (kind a)→⇩p n'› Label ‹CFG.pred (kind a) s›
‹length s = length s'›
show ?thesis by(fastforce intro:Proc_CFG_edge_rhs_pred_eq)
next
case Entry
with ‹c ⊢ n -IEdge (kind a)→⇩p n'› ‹CFG.pred (kind a) s›
show ?thesis by(fastforce dest:Proc_CFG_EntryD)
next
case Exit
with ‹c ⊢ n -IEdge (kind a)→⇩p n'› have False by fastforce
thus ?thesis by simp
qed
next
case (MainReturn l p es rets l' ins outs c)
with ‹λcf. snd cf = (Main, Label l')↩⇘p⇙λcf cf'. cf'(rets [:=] map cf outs) =
kind a›[THEN sym]
show ?case by fastforce
next
case (ProcReturn p ins outs c l p' es rets l' ins' outs' c')
with ‹λcf. snd cf = (p, Label l')↩⇘p'⇙λcf cf'. cf'(rets [:=] map cf outs') =
kind a›[THEN sym]
show ?case by fastforce
qed(auto dest:sym)
next
fix a Q r p fs ins outs
assume "valid_edge wfp a" and "kind a = Q:r↪⇘p⇙fs"
and "(p, ins, outs) ∈ set (lift_procs wfp)"
hence "prog,procs ⊢ sourcenode a -kind a→ targetnode a"
by(simp add:valid_edge_def)
from this ‹kind a = Q:r↪⇘p⇙fs› ‹(p, ins, outs) ∈ set (lift_procs wfp)›
show "length fs = length ins"
proof(induct rule:PCFG.induct)
case (MainCall l p' es rets n' ins' outs' c)
hence "fs = map interpret es" and "p' = p" by simp_all
with wf ‹(p, ins, outs) ∈ set (lift_procs wfp)›
‹(p', ins', outs', c) ∈ set procs›
have [simp]:"ins' = ins" by fastforce
from ‹prog ⊢ Label l -CEdge (p', es, rets)→⇩p n'›
have "containsCall procs prog [] p'" by(rule Proc_CFG_Call_containsCall)
with ‹wf prog procs› ‹(p', ins', outs', c) ∈ set procs›
‹prog ⊢ Label l -CEdge (p', es, rets)→⇩p n'›
have "length es = length ins" by fastforce
with ‹fs = map interpret es› show ?case by simp
next
case (ProcCall px insx outsx c l p' es' rets' l' ins' outs' c' ps)
hence "fs = map interpret es'" and "p' = p" by simp_all
with wf ‹(p, ins, outs) ∈ set (lift_procs wfp)›
‹(p', ins', outs', c') ∈ set procs›
have [simp]:"ins' = ins" by fastforce
from ‹c ⊢ Label l -CEdge (p', es', rets')→⇩p Label l'›
have "containsCall procs c [] p'" by(rule Proc_CFG_Call_containsCall)
with ‹containsCall procs prog ps px› ‹(px, insx, outsx, c) ∈ set procs›
have "containsCall procs prog (ps@[px]) p'" by(rule containsCall_in_proc)
with ‹wf prog procs› ‹(p', ins', outs', c') ∈ set procs›
‹c ⊢ Label l -CEdge (p', es', rets')→⇩p Label l'›
have "length es' = length ins" by fastforce
with ‹fs = map interpret es'› show ?case by simp
qed auto
next
fix a Q r p fs a' Q' r' p' fs' s s'
assume "valid_edge wfp a" and "kind a = Q:r↪⇘p⇙fs"
and "valid_edge wfp a'" and "kind a' = Q':r'↪⇘p'⇙fs'"
and "sourcenode a = sourcenode a'"
hence "prog,procs ⊢ sourcenode a -kind a→ targetnode a"
and "prog,procs ⊢ sourcenode a' -kind a'→ targetnode a'"
by(simp_all add:valid_edge_def)
from this ‹kind a = Q:r↪⇘p⇙fs› ‹kind a' = Q':r'↪⇘p'⇙fs'› show "a = a'"
proof(induct "sourcenode a" "kind a" "targetnode a" rule:PCFG.induct)
case (MainCall l px es rets n' insx outsx cx)
from ‹prog,procs ⊢ sourcenode a' -kind a'→ targetnode a'›
‹kind a' = Q':r'↪⇘p'⇙fs'›
‹(Main, Label l) = sourcenode a› ‹sourcenode a = sourcenode a'›
‹prog ⊢ Label l -CEdge (px, es, rets)→⇩p n'› wf
have "targetnode a' = (px, Entry)"
by(fastforce elim!:PCFG.cases dest:Proc_CFG_Call_nodes_eq)
with ‹valid_edge wfp a› ‹valid_edge wfp a'›
‹sourcenode a = sourcenode a'› ‹(px, Entry) = targetnode a› wf
have "kind a = kind a'" by(fastforce intro:Proc_CFG_edge_det simp:valid_edge_def)
with ‹sourcenode a = sourcenode a'› ‹(px, Entry) = targetnode a›
‹targetnode a' = (px, Entry)›
show ?case by(cases a,cases a',auto)
next
case (ProcCall px ins outs c l px' es rets l' insx outsx cx)
with wf have "px ≠ Main" by fastforce
with ‹prog,procs ⊢ sourcenode a' -kind a'→ targetnode a'›
‹kind a' = Q':r'↪⇘p'⇙fs'›
‹(px, Label l) = sourcenode a› ‹sourcenode a = sourcenode a'›
‹c ⊢ Label l -CEdge (px', es, rets)→⇩p Label l'›
‹(px', insx, outsx, cx) ∈ set procs› ‹(px, ins, outs, c) ∈ set procs›
have "targetnode a' = (px', Entry)"
proof(induct n≡"sourcenode a'" et≡"kind a'" n'≡"targetnode a'" rule:PCFG.induct)
case (ProcCall p insa outsa ca la p'a es' rets' l'a ins' outs' c')
hence [simp]:"px = p" "l = la" by(auto dest:sym)
from ‹(p, insa, outsa, ca) ∈ set procs›
‹(px, ins, outs, c) ∈ set procs› wf have [simp]:"ca = c" by auto
from ‹ca ⊢ Label la -CEdge (p'a, es', rets')→⇩p Label l'a›
‹c ⊢ Label l -CEdge (px', es, rets)→⇩p Label l'›
have "p'a = px'" by(fastforce dest:Proc_CFG_Call_nodes_eq)
with ‹(p'a, Entry) = targetnode a'› show ?case by simp
qed(auto dest:sym)
with ‹valid_edge wfp a› ‹valid_edge wfp a'›
‹sourcenode a = sourcenode a'› ‹(px', Entry) = targetnode a› wf
have "kind a = kind a'" by(fastforce intro:Proc_CFG_edge_det simp:valid_edge_def)
with ‹sourcenode a = sourcenode a'› ‹(px', Entry) = targetnode a›
‹targetnode a' = (px', Entry)› show ?case by(cases a,cases a',auto)
qed auto
next
fix a Q r p fs i ins outs fix s s'::"((char list ⇀ val) × node) list"
assume "valid_edge wfp a" and "kind a = Q:r↪⇘p⇙fs" and "i < length ins"
and "(p, ins, outs) ∈ set (lift_procs wfp)"
and "∀V∈ParamUses wfp (sourcenode a) ! i. state_val s V = state_val s' V"
hence "prog,procs ⊢ sourcenode a -kind a→ targetnode a"
by(simp add:valid_edge_def)
from this ‹kind a = Q:r↪⇘p⇙fs› ‹i < length ins›
‹(p, ins, outs) ∈ set (lift_procs wfp)›
‹∀V∈ParamUses wfp (sourcenode a) ! i. state_val s V = state_val s' V›
show "CFG.params fs (state_val s) ! i = CFG.params fs (state_val s') ! i"
proof(induct "sourcenode a" "kind a" "targetnode a" rule:PCFG.induct)
case (MainCall l p' es rets n' insx outsx cx)
with wf have [simp]:"insx = ins" "fs = map interpret es" by auto
from ‹prog ⊢ Label l -CEdge (p', es, rets)→⇩p n'›
have "containsCall procs prog [] p'" by(rule Proc_CFG_Call_containsCall)
with ‹wf prog procs› ‹(p', insx, outsx, cx) ∈ set procs›
‹prog ⊢ Label l -CEdge (p', es, rets)→⇩p n'›
have "length es = length ins" by fastforce
with ‹i < length ins› have "i < length (map interpret es)" by simp
from ‹prog ⊢ Label l -CEdge (p', es, rets)→⇩p n'›
have "ParamUses wfp (Main,Label l) = map fv es"
by(fastforce intro:ParamUses_Main_Return_target)
with ‹∀V∈ParamUses wfp (sourcenode a) ! i. state_val s V = state_val s' V›
‹i < length (map interpret es)› ‹(Main, Label l) = sourcenode a›
have " ((map (λe cf. interpret e cf) es)!i) (fst (hd s)) =
((map (λe cf. interpret e cf) es)!i) (fst (hd s'))"
by(cases "interpret (es ! i) (fst (hd s))")(auto dest:rhs_interpret_eq)
with ‹i < length (map interpret es)› show ?case by(simp add:ProcCFG.params_nth)
next
case (ProcCall px insx outsx cx l p' es' rets' l' ins' outs' c' ps)
with wf have [simp]:"ins' = ins" by fastforce
from ‹cx ⊢ Label l -CEdge (p', es', rets')→⇩p Label l'›
have "containsCall procs cx [] p'" by(rule Proc_CFG_Call_containsCall)
with ‹containsCall procs prog ps px› ‹(px, insx, outsx, cx) ∈ set procs›
have "containsCall procs prog (ps@[px]) p'" by(rule containsCall_in_proc)
with ‹wf prog procs› ‹(p', ins', outs', c') ∈ set procs›
‹cx ⊢ Label l -CEdge (p', es', rets')→⇩p Label l'›
have "length es' = length ins" by fastforce
from ‹λs. True:(px, Label l')↪⇘p'⇙map interpret es' = kind a› ‹kind a = Q:r↪⇘p⇙fs›
have "fs = map interpret es'" by simp_all
from ‹i < length ins› ‹fs = map interpret es'›
‹length es' = length ins› have "i < length fs" by simp
from ‹(px, insx, outsx, cx) ∈ set procs›
‹cx ⊢ Label l -CEdge (p', es', rets')→⇩p Label l'›
have "ParamUses wfp (px,Label l) = map fv es'"
by(auto intro!:ParamUses_Proc_Return_target simp:set_conv_nth)
with ‹∀V∈ParamUses wfp (sourcenode a) ! i. state_val s V = state_val s' V›
‹(px, Label l) = sourcenode a› ‹i < length fs›
‹fs = map interpret es'›
have " ((map (λe cf. interpret e cf) es')!i) (fst (hd s)) =
((map (λe cf. interpret e cf) es')!i) (fst (hd s'))"
by(cases "interpret (es' ! i) (fst (hd s))")(auto dest:rhs_interpret_eq)
with ‹i < length fs› ‹fs = map interpret es'›
show ?case by(simp add:ProcCFG.params_nth)
qed auto
next
fix a Q' p f' ins outs cf cf'
assume "valid_edge wfp a" and "kind a = Q'↩⇘p⇙f'"
and "(p, ins, outs) ∈ set (lift_procs wfp)"
thus "f' cf cf' = cf'(ParamDefs wfp (targetnode a) [:=] map cf outs)"
by(rule Return_update)
next
fix a a'
assume "valid_edge wfp a" and "valid_edge wfp a'"
and "sourcenode a = sourcenode a'" and "targetnode a ≠ targetnode a'"
and "intra_kind (kind a)" and "intra_kind (kind a')"
with wf show "∃Q Q'. kind a = (Q)⇩√ ∧ kind a' = (Q')⇩√ ∧
(∀cf. (Q cf ⟶ ¬ Q' cf) ∧ (Q' cf ⟶ ¬ Q cf))"
by(auto dest:Proc_CFG_deterministic simp:valid_edge_def)
qed
qed
subsection ‹Instantiating the ‹CFGExit_wf› locale›
interpretation ProcCFGExit_wf:
CFGExit_wf sourcenode targetnode kind "valid_edge wfp" "(Main,Entry)"
get_proc "get_return_edges wfp" "lift_procs wfp" Main "(Main,Exit)"
"Def wfp" "Use wfp" "ParamDefs wfp" "ParamUses wfp"
for wfp
proof
from Exit_Def_empty Exit_Use_empty
show "Def wfp (Main, Exit) = {} ∧ Use wfp (Main, Exit) = {}" by simp
qed
end
Theory ValidPaths
section ‹Lemmas concerning paths to instantiate locale Postdomination›
theory ValidPaths imports WellFormed "../StaticInter/Postdomination" begin
subsection ‹Intraprocedural paths from method entry and to method exit›
abbreviation path :: "wf_prog ⇒ node ⇒ edge list ⇒ node ⇒ bool" ("_ ⊢ _ -_→* _")
where "wfp ⊢ n -as→* n' ≡ CFG.path sourcenode targetnode (valid_edge wfp) n as n'"
definition label_incrs :: "edge list ⇒ nat ⇒ edge list" ("_ ⊕s _" 60)
where "as ⊕s i ≡ map (λ((p,n),et,(p',n')). ((p,n ⊕ i),et,(p',n' ⊕ i))) as"
declare One_nat_def [simp del]
subsubsection ‹From ‹prog› to ‹prog;;c⇩2››
lemma Proc_CFG_edge_SeqFirst_nodes_Label:
"prog ⊢ Label l -et→⇩p Label l' ⟹ prog;;c⇩2 ⊢ Label l -et→⇩p Label l'"
proof(induct prog "Label l" et "Label l'" rule:Proc_CFG.induct)
case (Proc_CFG_SeqSecond c⇩2' n et n' c⇩1)
hence "(c⇩1;; c⇩2');; c⇩2 ⊢ n ⊕ #:c⇩1 -et→⇩p n' ⊕ #:c⇩1"
by(fastforce intro:Proc_CFG_SeqFirst Proc_CFG.Proc_CFG_SeqSecond)
with ‹n ⊕ #:c⇩1 = Label l› ‹n' ⊕ #:c⇩1 = Label l'› show ?case by fastforce
next
case (Proc_CFG_CondThen c⇩1 n et n' b c⇩2')
hence "if (b) c⇩1 else c⇩2';; c⇩2 ⊢ n ⊕ 1 -et→⇩p n' ⊕ 1"
by(fastforce intro:Proc_CFG_SeqFirst Proc_CFG.Proc_CFG_CondThen)
with ‹n ⊕ 1 = Label l› ‹n' ⊕ 1 = Label l'› show ?case by fastforce
next
case (Proc_CFG_CondElse c⇩1 n et n' b c⇩2')
hence "if (b) c⇩2' else c⇩1 ;; c⇩2 ⊢ n ⊕ #:c⇩2' + 1 -et→⇩p n' ⊕ (#:c⇩2' + 1)"
by(fastforce intro:Proc_CFG_SeqFirst Proc_CFG.Proc_CFG_CondElse)
with ‹n ⊕ #:c⇩2' + 1 = Label l› ‹n' ⊕ #:c⇩2' + 1 = Label l'› show ?case by fastforce
next
case (Proc_CFG_WhileBody c' n et n' b)
hence "while (b) c';; c⇩2 ⊢ n ⊕ 2 -et→⇩p n' ⊕ 2"
by(fastforce intro:Proc_CFG_SeqFirst Proc_CFG.Proc_CFG_WhileBody)
with ‹n ⊕ 2 = Label l› ‹n' ⊕ 2 = Label l'› show ?case by fastforce
next
case (Proc_CFG_WhileBodyExit c' n et b)
hence "while (b) c';; c⇩2 ⊢ n ⊕ 2 -et→⇩p Label 0"
by(fastforce intro:Proc_CFG_SeqFirst Proc_CFG.Proc_CFG_WhileBodyExit)
with ‹n ⊕ 2 = Label l› ‹0 = l'› show ?case by fastforce
qed (auto intro:Proc_CFG.intros)
lemma Proc_CFG_edge_SeqFirst_source_Label:
assumes "prog ⊢ Label l -et→⇩p n'"
obtains nx where "prog;;c⇩2 ⊢ Label l -et→⇩p nx"
proof(atomize_elim)
from ‹prog ⊢ Label l -et→⇩p n'› obtain n where "prog ⊢ n -et→⇩p n'" and "Label l = n"
by simp
thus "∃nx. prog;;c⇩2 ⊢ Label l -et→⇩p nx"
proof(induct prog n et n' rule:Proc_CFG.induct)
case (Proc_CFG_SeqSecond c⇩2' n et n' c⇩1)
show ?case
proof(cases "n' = Exit")
case True
with ‹c⇩2' ⊢ n -et→⇩p n'› ‹n ≠ Entry› have "c⇩1;; c⇩2' ⊢ n ⊕ #:c⇩1 -et→⇩p Exit ⊕ #:c⇩1"
by(fastforce intro:Proc_CFG.Proc_CFG_SeqSecond)
moreover from ‹n ≠ Entry› have "n ⊕ #:c⇩1 ≠ Entry" by(cases n) auto
ultimately
have "c⇩1;; c⇩2';; c⇩2 ⊢ n ⊕ #:c⇩1 -et→⇩p Label (#:c⇩1;; c⇩2')"
by(fastforce intro:Proc_CFG_SeqConnect)
with ‹Label l = n ⊕ #:c⇩1› show ?thesis by fastforce
next
case False
with Proc_CFG_SeqSecond
have "(c⇩1;; c⇩2');; c⇩2 ⊢ n ⊕ #:c⇩1 -et→⇩p n' ⊕ #:c⇩1"
by(fastforce intro:Proc_CFG_SeqFirst Proc_CFG.Proc_CFG_SeqSecond)
with ‹Label l = n ⊕ #:c⇩1› show ?thesis by fastforce
qed
next
case (Proc_CFG_CondThen c⇩1 n et n' b c⇩2')
show ?case
proof(cases "n' = Exit")
case True
with ‹c⇩1 ⊢ n -et→⇩p n'› ‹n ≠ Entry›
have "if (b) c⇩1 else c⇩2' ⊢ n ⊕ 1 -et→⇩p Exit ⊕ 1"
by(fastforce intro:Proc_CFG.Proc_CFG_CondThen)
moreover from ‹n ≠ Entry› have "n ⊕ 1 ≠ Entry" by(cases n) auto
ultimately
have "if (b) c⇩1 else c⇩2';; c⇩2 ⊢ n ⊕ 1 -et→⇩p Label (#:if (b) c⇩1 else c⇩2')"
by(fastforce intro:Proc_CFG_SeqConnect)
with ‹Label l = n ⊕ 1› show ?thesis by fastforce
next
case False
hence "n' ⊕ 1 ≠ Exit" by(cases n') auto
with Proc_CFG_CondThen
have "if (b) c⇩1 else c⇩2';; c⇩2 ⊢ Label l -et→⇩p n' ⊕ 1"
by(fastforce intro:Proc_CFG_SeqFirst Proc_CFG.Proc_CFG_CondThen)
with ‹Label l = n ⊕ 1› show ?thesis by fastforce
qed
next
case (Proc_CFG_CondElse c⇩1 n et n' b c⇩2')
show ?case
proof(cases "n' = Exit")
case True
with ‹c⇩1 ⊢ n -et→⇩p n'› ‹n ≠ Entry›
have "if (b) c⇩2' else c⇩1 ⊢ n ⊕ (#:c⇩2' + 1) -et→⇩p Exit ⊕ (#:c⇩2' + 1)"
by(fastforce intro:Proc_CFG.Proc_CFG_CondElse)
moreover from ‹n ≠ Entry› have "n ⊕ (#:c⇩2' + 1) ≠ Entry" by(cases n) auto
ultimately
have "if (b) c⇩2' else c⇩1;; c⇩2 ⊢ n ⊕ (#:c⇩2' + 1) -et→⇩p
Label (#:if (b) c⇩2' else c⇩1)"
by(fastforce intro:Proc_CFG_SeqConnect)
with ‹Label l = n ⊕ (#:c⇩2' + 1)› show ?thesis by fastforce
next
case False
hence "n' ⊕ (#:c⇩2' + 1) ≠ Exit" by(cases n') auto
with Proc_CFG_CondElse
have "if (b) c⇩2' else c⇩1 ;; c⇩2 ⊢ Label l -et→⇩p n' ⊕ (#:c⇩2' + 1)"
by(fastforce intro:Proc_CFG_SeqFirst Proc_CFG.Proc_CFG_CondElse)
with ‹Label l = n ⊕ (#:c⇩2' + 1)› show ?thesis by fastforce
qed
qed (auto intro:Proc_CFG.intros)
qed
lemma Proc_CFG_edge_SeqFirst_target_Label:
"⟦prog ⊢ n -et→⇩p n'; Label l' = n'⟧ ⟹ prog;;c⇩2 ⊢ n -et→⇩p Label l'"
proof(induct prog n et n' rule:Proc_CFG.induct)
case (Proc_CFG_SeqSecond c⇩2' n et n' c⇩1)
from ‹Label l' = n' ⊕ #:c⇩1› have "n' ≠ Exit" by(cases n') auto
with Proc_CFG_SeqSecond
show ?case by(fastforce intro:Proc_CFG_SeqFirst intro:Proc_CFG.Proc_CFG_SeqSecond)
next
case (Proc_CFG_CondThen c⇩1 n et n' b c⇩2')
from ‹Label l' = n' ⊕ 1› have "n' ≠ Exit" by(cases n') auto
with Proc_CFG_CondThen
show ?case by(fastforce intro:Proc_CFG_SeqFirst Proc_CFG.Proc_CFG_CondThen)
qed (auto intro:Proc_CFG.intros)
lemma PCFG_edge_SeqFirst_source_Label:
assumes "prog,procs ⊢ (p,Label l) -et→ (p',n')"
obtains nx where "prog;;c⇩2,procs ⊢ (p,Label l) -et→ (p',nx)"
proof(atomize_elim)
from ‹prog,procs ⊢ (p,Label l) -et→ (p',n')›
show "∃nx. prog;;c⇩2,procs ⊢ (p,Label l) -et→ (p',nx)"
proof(induct "(p,Label l)" et "(p',n')" rule:PCFG.induct)
case (Main et)
from ‹prog ⊢ Label l -IEdge et→⇩p n'›
obtain nx' where "prog;;c⇩2 ⊢ Label l -IEdge et→⇩p nx'"
by(auto elim:Proc_CFG_edge_SeqFirst_source_Label)
with ‹Main = p› ‹Main = p'› show ?case
by(fastforce dest:PCFG.Main)
next
case (Proc ins outs c et ps)
from ‹containsCall procs prog ps p›
have "containsCall procs (prog;;c⇩2) ps p" by simp
with Proc show ?case by(fastforce dest:PCFG.Proc)
next
case (MainCall es rets nx ins outs c)
from ‹prog ⊢ Label l -CEdge (p', es, rets)→⇩p nx›
obtain lx where [simp]:"nx = Label lx" by(fastforce dest:Proc_CFG_Call_Labels)
with ‹prog ⊢ Label l -CEdge (p', es, rets)→⇩p nx›
have "prog;;c⇩2 ⊢ Label l -CEdge (p', es, rets)→⇩p Label lx"
by(auto intro:Proc_CFG_edge_SeqFirst_nodes_Label)
with MainCall show ?case by(fastforce dest:PCFG.MainCall)
next
case (ProcCall ins outs c es' rets' l' ins' outs' c' ps)
from ‹containsCall procs prog ps p›
have "containsCall procs (prog;;c⇩2) ps p" by simp
with ProcCall show ?case by(fastforce intro:PCFG.ProcCall)
next
case (MainCallReturn px es rets)
from ‹prog ⊢ Label l -CEdge (px, es, rets)→⇩p n'› ‹Main = p›
obtain nx'' where "prog;;c⇩2 ⊢ Label l -CEdge (px, es, rets)→⇩p nx''"
by(auto elim:Proc_CFG_edge_SeqFirst_source_Label)
with MainCallReturn show ?case by(fastforce dest:PCFG.MainCallReturn)
next
case (ProcCallReturn ins outs c px' es' rets' ps)
from ‹containsCall procs prog ps p›
have "containsCall procs (prog;;c⇩2) ps p" by simp
with ProcCallReturn show ?case by(fastforce dest!:PCFG.ProcCallReturn)
qed
qed
lemma PCFG_edge_SeqFirst_target_Label:
"prog,procs ⊢ (p,n) -et→ (p',Label l')
⟹ prog;;c⇩2,procs ⊢ (p,n) -et→ (p',Label l')"
proof(induct "(p,n)" et "(p',Label l')" rule:PCFG.induct)
case Main
thus ?case by(fastforce dest:Proc_CFG_edge_SeqFirst_target_Label intro:PCFG.Main)
next
case (Proc ins outs c et ps)
from ‹containsCall procs prog ps p›
have "containsCall procs (prog;;c⇩2) ps p" by simp
with Proc show ?case by(fastforce dest:PCFG.Proc)
next
case MainReturn thus ?case
by(fastforce dest:Proc_CFG_edge_SeqFirst_target_Label
intro!:PCFG.MainReturn[simplified])
next
case (ProcReturn ins outs c lx es' rets' ins' outs' c' ps)
from ‹containsCall procs prog ps p'›
have "containsCall procs (prog;;c⇩2) ps p'" by simp
with ProcReturn show ?case by(fastforce intro:PCFG.ProcReturn)
next
case MainCallReturn thus ?case
by(fastforce dest:Proc_CFG_edge_SeqFirst_target_Label intro:PCFG.MainCallReturn)
next
case (ProcCallReturn ins outs c px' es' rets' ps)
from ‹containsCall procs prog ps p›
have "containsCall procs (prog;;c⇩2) ps p" by simp
with ProcCallReturn show ?case by(fastforce dest!:PCFG.ProcCallReturn)
qed
lemma path_SeqFirst:
assumes "Rep_wf_prog wfp = (prog,procs)" and "Rep_wf_prog wfp' = (prog;;c⇩2,procs)"
shows "⟦wfp ⊢ (p,n) -as→* (p,Label l); ∀a ∈ set as. intra_kind (kind a)⟧
⟹ wfp' ⊢ (p,n) -as→* (p,Label l)"
proof(induct "(p,n)" as "(p,Label l)" arbitrary:n rule:ProcCFG.path.induct)
case empty_path
from ‹CFG.valid_node sourcenode targetnode (valid_edge wfp) (p, Label l)›
‹Rep_wf_prog wfp = (prog, procs)› ‹Rep_wf_prog wfp' = (prog;; c⇩2, procs)›
have "CFG.valid_node sourcenode targetnode (valid_edge wfp') (p, Label l)"
apply(auto simp:ProcCFG.valid_node_def valid_edge_def)
apply(erule PCFG_edge_SeqFirst_source_Label,fastforce)
by(drule PCFG_edge_SeqFirst_target_Label,fastforce)
thus ?case by(fastforce intro:ProcCFG.empty_path)
next
case (Cons_path n'' as a nx)
note IH = ‹⋀n. ⟦n'' = (p, n); ∀a∈set as. intra_kind (kind a)⟧
⟹ wfp' ⊢ (p, n) -as→* (p, Label l)›
note [simp] = ‹Rep_wf_prog wfp = (prog,procs)› ‹Rep_wf_prog wfp' = (prog;;c⇩2,procs)›
from ‹Rep_wf_prog wfp = (prog,procs)› have wf:"well_formed procs"
by(fastforce intro:wf_wf_prog)
from ‹∀a∈set (a # as). intra_kind (kind a)› have "intra_kind (kind a)"
and "∀a∈set as. intra_kind (kind a)" by simp_all
from ‹valid_edge wfp a› ‹sourcenode a = (p, nx)› ‹targetnode a = n''›
‹intra_kind (kind a)› wf
obtain nx' where "n'' = (p,nx')"
by(auto elim:PCFG.cases simp:valid_edge_def intra_kind_def)
from IH[OF this ‹∀a∈set as. intra_kind (kind a)›]
have path:"wfp' ⊢ (p, nx') -as→* (p, Label l)" .
have "valid_edge wfp' a"
proof(cases nx')
case (Label lx)
with ‹valid_edge wfp a› ‹sourcenode a = (p, nx)› ‹targetnode a = n''›
‹n'' = (p,nx')› show ?thesis
by(fastforce intro:PCFG_edge_SeqFirst_target_Label
simp:intra_kind_def valid_edge_def)
next
case Entry
with ‹valid_edge wfp a› ‹targetnode a = n''› ‹n'' = (p,nx')›
‹intra_kind (kind a)› have False
by(auto elim:PCFG.cases simp:valid_edge_def intra_kind_def)
thus ?thesis by simp
next
case Exit
with path ‹∀a∈set as. intra_kind (kind a)› have False
by(induct "(p,nx')" as "(p,Label l)" rule:ProcCFG.path.induct)
(auto elim!:PCFG.cases simp:valid_edge_def intra_kind_def)
thus ?thesis by simp
qed
with ‹sourcenode a = (p, nx)› ‹targetnode a = n''› ‹n'' = (p,nx')› path
show ?case by(fastforce intro:ProcCFG.Cons_path)
qed
subsubsection ‹From ‹prog› to ‹c⇩1;;prog››
lemma Proc_CFG_edge_SeqSecond_source_not_Entry:
"⟦prog ⊢ n -et→⇩p n'; n ≠ Entry⟧ ⟹ c⇩1;;prog ⊢ n ⊕ #:c⇩1 -et→⇩p n' ⊕ #:c⇩1"
by(induct rule:Proc_CFG.induct)(fastforce intro:Proc_CFG_SeqSecond Proc_CFG.intros)+
lemma PCFG_Main_edge_SeqSecond_source_not_Entry:
"⟦prog,procs ⊢ (Main,n) -et→ (p',n'); n ≠ Entry; intra_kind et; well_formed procs⟧
⟹ c⇩1;;prog,procs ⊢ (Main,n ⊕ #:c⇩1) -et→ (p',n' ⊕ #:c⇩1)"
proof(induct "(Main,n)" et "(p',n')" rule:PCFG.induct)
case Main
thus ?case
by(fastforce dest:Proc_CFG_edge_SeqSecond_source_not_Entry intro:PCFG.Main)
next
case (MainCallReturn p es rets)
from ‹prog ⊢ n -CEdge (p, es, rets)→⇩p n'› ‹n ≠ Entry›
have "c⇩1;;prog ⊢ n ⊕ #:c⇩1 -CEdge (p, es, rets)→⇩p n' ⊕ #:c⇩1"
by(rule Proc_CFG_edge_SeqSecond_source_not_Entry)
with MainCallReturn show ?case by(fastforce intro:PCFG.MainCallReturn)
qed (auto simp:intra_kind_def)
lemma valid_node_Main_SeqSecond:
assumes "CFG.valid_node sourcenode targetnode (valid_edge wfp) (Main,n)"
and "n ≠ Entry" and "Rep_wf_prog wfp = (prog,procs)"
and "Rep_wf_prog wfp' = (c⇩1;;prog,procs)"
shows "CFG.valid_node sourcenode targetnode (valid_edge wfp') (Main, n ⊕ #:c⇩1)"
proof -
note [simp] = ‹Rep_wf_prog wfp = (prog,procs)› ‹Rep_wf_prog wfp' = (c⇩1;;prog,procs)›
from ‹Rep_wf_prog wfp = (prog,procs)› have wf:"well_formed procs"
by(fastforce intro:wf_wf_prog)
from ‹CFG.valid_node sourcenode targetnode (valid_edge wfp) (Main,n)›
obtain a where "prog,procs ⊢ sourcenode a -kind a→ targetnode a"
and "(Main,n) = sourcenode a ∨ (Main,n) = targetnode a"
by(fastforce simp:ProcCFG.valid_node_def valid_edge_def)
from this ‹n ≠ Entry› wf show ?thesis
proof(induct "sourcenode a" "kind a" "targetnode a" rule:PCFG.induct)
case (Main nx nx')
from ‹(Main,n) = sourcenode a ∨ (Main,n) = targetnode a› show ?case
proof
assume "(Main,n) = sourcenode a"
with ‹(Main, nx) = sourcenode a›[THEN sym] have [simp]:"nx = n" by simp
from ‹n ≠ Entry› ‹prog ⊢ nx -IEdge (kind a)→⇩p nx'›
have "c⇩1;;prog ⊢ n ⊕ #:c⇩1 -IEdge (kind a)→⇩p nx' ⊕ #:c⇩1"
by(fastforce intro:Proc_CFG_edge_SeqSecond_source_not_Entry)
hence "c⇩1;;prog,procs ⊢ (Main,n ⊕ #:c⇩1) -kind a→ (Main,nx' ⊕ #:c⇩1)"
by(rule PCFG.Main)
thus ?thesis by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
next
assume "(Main, n) = targetnode a"
show ?thesis
proof(cases "nx = Entry")
case True
with ‹prog ⊢ nx -IEdge (kind a)→⇩p nx'›
have "nx' = Exit ∨ nx' = Label 0" by(fastforce dest:Proc_CFG_EntryD)
thus ?thesis
proof
assume "nx' = Exit"
with ‹(Main, n) = targetnode a› ‹(Main, nx') = targetnode a›[THEN sym]
show ?thesis by simp
next
assume "nx' = Label 0"
obtain l etx where "c⇩1 ⊢ Label l -IEdge etx→⇩p Exit" and "l ≤ #:c⇩1"
by(erule Proc_CFG_Exit_edge)
hence "c⇩1;;prog ⊢ Label l -IEdge etx→⇩p Label #:c⇩1"
by(fastforce intro:Proc_CFG_SeqConnect)
with ‹nx' = Label 0›
have "c⇩1;;prog,procs ⊢ (Main,Label l) -etx→ (Main,nx'⊕#:c⇩1)"
by(fastforce intro:PCFG.Main)
with ‹(Main, n) = targetnode a› ‹(Main, nx') = targetnode a›[THEN sym]
show ?thesis
by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
qed
next
case False
with ‹prog ⊢ nx -IEdge (kind a)→⇩p nx'›
have "c⇩1;;prog ⊢ nx ⊕ #:c⇩1 -IEdge (kind a)→⇩p nx' ⊕ #:c⇩1"
by(fastforce intro:Proc_CFG_edge_SeqSecond_source_not_Entry)
hence "c⇩1;;prog,procs ⊢ (Main,nx ⊕ #:c⇩1) -kind a→ (Main,nx' ⊕ #:c⇩1)"
by(rule PCFG.Main)
with ‹(Main, n) = targetnode a› ‹(Main, nx') = targetnode a›[THEN sym]
show ?thesis by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
qed
qed
next
case (Proc p ins outs c nx n' ps)
from ‹(p, nx) = sourcenode a›[THEN sym] ‹(p, n') = targetnode a›[THEN sym]
‹(Main, n) = sourcenode a ∨ (Main, n) = targetnode a›
‹(p, ins, outs, c) ∈ set procs› ‹well_formed procs› have False by fastforce
thus ?case by simp
next
case (MainCall l p es rets n' ins outs c)
from ‹(p, ins, outs, c) ∈ set procs› wf ‹(p, Entry) = targetnode a›[THEN sym]
‹(Main, Label l) = sourcenode a›[THEN sym]
‹(Main, n) = sourcenode a ∨ (Main, n) = targetnode a›
have [simp]:"n = Label l" by fastforce
from ‹prog ⊢ Label l -CEdge (p, es, rets)→⇩p n'›
have "c⇩1;;prog ⊢ Label l ⊕ #:c⇩1 -CEdge (p, es, rets)→⇩p n' ⊕ #:c⇩1"
by -(rule Proc_CFG_edge_SeqSecond_source_not_Entry,auto)
with ‹(p, ins, outs, c) ∈ set procs›
have "c⇩1;;prog,procs ⊢ (Main,Label (l + #:c⇩1))
-(λs. True):(Main,n' ⊕ #:c⇩1)↪⇘p⇙map (λe cf. interpret e cf) es→ (p,Entry)"
by(fastforce intro:PCFG.MainCall)
thus ?case by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
next
case (ProcCall p ins outs c l p' es' rets' l' ins' outs' c')
from ‹(p, Label l) = sourcenode a›[THEN sym]
‹(p', Entry) = targetnode a›[THEN sym] ‹well_formed procs›
‹(p, ins, outs, c) ∈ set procs› ‹(p', ins', outs', c') ∈ set procs›
‹(Main, n) = sourcenode a ∨ (Main, n) = targetnode a›
have False by fastforce
thus ?case by simp
next
case (MainReturn l p es rets l' ins outs c)
from ‹(p, ins, outs, c) ∈ set procs› wf ‹(p, Exit) = sourcenode a›[THEN sym]
‹(Main, Label l') = targetnode a›[THEN sym]
‹(Main, n) = sourcenode a ∨ (Main, n) = targetnode a›
have [simp]:"n = Label l'" by fastforce
from ‹prog ⊢ Label l -CEdge (p, es, rets)→⇩p Label l'›
have "c⇩1;;prog ⊢ Label l ⊕ #:c⇩1 -CEdge (p, es, rets)→⇩p Label l' ⊕ #:c⇩1"
by -(rule Proc_CFG_edge_SeqSecond_source_not_Entry,auto)
with ‹(p, ins, outs, c) ∈ set procs›
have "c⇩1;;prog,procs ⊢ (p,Exit) -(λcf. snd cf = (Main,Label l' ⊕ #:c⇩1))↩⇘p⇙
(λcf cf'. cf'(rets [:=] map cf outs))→ (Main,Label (l' + #:c⇩1))"
by(fastforce intro:PCFG.MainReturn)
thus ?case by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
next
case (ProcReturn p ins outs c l p' es' rets' l' ins' outs' c' ps)
from ‹(p', Exit) = sourcenode a›[THEN sym]
‹(p, Label l') = targetnode a›[THEN sym] ‹well_formed procs›
‹(p, ins, outs, c) ∈ set procs› ‹(p', ins', outs', c') ∈ set procs›
‹(Main, n) = sourcenode a ∨ (Main, n) = targetnode a›
have False by fastforce
thus ?case by simp
next
case (MainCallReturn nx p es rets nx')
from ‹(Main,n) = sourcenode a ∨ (Main,n) = targetnode a› show ?case
proof
assume "(Main,n) = sourcenode a"
with ‹(Main, nx) = sourcenode a›[THEN sym] have [simp]:"nx = n" by simp
from ‹n ≠ Entry› ‹prog ⊢ nx -CEdge (p, es, rets)→⇩p nx'›
have "c⇩1;;prog ⊢ n ⊕ #:c⇩1 -CEdge (p, es, rets)→⇩p nx' ⊕ #:c⇩1"
by(fastforce intro:Proc_CFG_edge_SeqSecond_source_not_Entry)
hence "c⇩1;;prog,procs ⊢ (Main,n ⊕ #:c⇩1) -(λs. False)⇩√→ (Main,nx' ⊕ #:c⇩1)"
by -(rule PCFG.MainCallReturn)
thus ?thesis by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
next
assume "(Main, n) = targetnode a"
from ‹prog ⊢ nx -CEdge (p, es, rets)→⇩p nx'›
have "nx ≠ Entry" by(fastforce dest:Proc_CFG_Call_Labels)
with ‹prog ⊢ nx -CEdge (p, es, rets)→⇩p nx'›
have "c⇩1;;prog ⊢ nx ⊕ #:c⇩1 -CEdge (p, es, rets)→⇩p nx' ⊕ #:c⇩1"
by(fastforce intro:Proc_CFG_edge_SeqSecond_source_not_Entry)
hence "c⇩1;;prog,procs ⊢ (Main,nx ⊕ #:c⇩1) -(λs. False)⇩√→ (Main,nx' ⊕ #:c⇩1)"
by -(rule PCFG.MainCallReturn)
with ‹(Main, n) = targetnode a› ‹(Main, nx') = targetnode a›[THEN sym]
show ?thesis by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
qed
next
case (ProcCallReturn p ins outs c nx p' es' rets' n' ps)
from ‹(p, nx) = sourcenode a›[THEN sym] ‹(p, n') = targetnode a›[THEN sym]
‹(p, ins, outs, c) ∈ set procs› ‹well_formed procs›
‹(Main, n) = sourcenode a ∨ (Main, n) = targetnode a›
have False by fastforce
thus ?case by simp
qed
qed
lemma path_Main_SeqSecond:
assumes "Rep_wf_prog wfp = (prog,procs)" and "Rep_wf_prog wfp' = (c⇩1;;prog,procs)"
shows "⟦wfp ⊢ (Main,n) -as→* (p',n'); ∀a ∈ set as. intra_kind (kind a); n ≠ Entry⟧
⟹ wfp' ⊢ (Main,n ⊕ #:c⇩1) -as ⊕s #:c⇩1→* (p',n' ⊕ #:c⇩1)"
proof(induct "(Main,n)" as "(p',n')" arbitrary:n rule:ProcCFG.path.induct)
case empty_path
from ‹CFG.valid_node sourcenode targetnode (valid_edge wfp) (Main, n')›
‹n' ≠ Entry› ‹Rep_wf_prog wfp = (prog,procs)›
‹Rep_wf_prog wfp' = (c⇩1;;prog,procs)›
have "CFG.valid_node sourcenode targetnode (valid_edge wfp') (Main, n' ⊕ #:c⇩1)"
by(fastforce intro:valid_node_Main_SeqSecond)
with ‹Main = p'› show ?case
by(fastforce intro:ProcCFG.empty_path simp:label_incrs_def)
next
case (Cons_path n'' as a n)
note IH = ‹⋀n. ⟦n'' = (Main, n); ∀a∈set as. intra_kind (kind a); n ≠ Entry⟧
⟹ wfp' ⊢ (Main, n ⊕ #:c⇩1) -as ⊕s #:c⇩1→* (p', n' ⊕ #:c⇩1)›
note [simp] = ‹Rep_wf_prog wfp = (prog,procs)› ‹Rep_wf_prog wfp' = (c⇩1;;prog,procs)›
from ‹Rep_wf_prog wfp = (prog,procs)› have wf:"well_formed procs"
by(fastforce intro:wf_wf_prog)
from ‹∀a∈set (a # as). intra_kind (kind a)› have "intra_kind (kind a)"
and "∀a∈set as. intra_kind (kind a)" by simp_all
from ‹valid_edge wfp a› ‹sourcenode a = (Main, n)› ‹targetnode a = n''›
‹intra_kind (kind a)› wf
obtain nx'' where "n'' = (Main,nx'')" and "nx'' ≠ Entry"
by(auto elim!:PCFG.cases simp:valid_edge_def intra_kind_def)
from IH[OF ‹n'' = (Main,nx'')› ‹∀a∈set as. intra_kind (kind a)› ‹nx'' ≠ Entry›]
have path:"wfp' ⊢ (Main, nx'' ⊕ #:c⇩1) -as ⊕s #:c⇩1→* (p', n' ⊕ #:c⇩1)" .
from ‹valid_edge wfp a› ‹sourcenode a = (Main, n)› ‹targetnode a = n''›
‹n'' = (Main,nx'')› ‹n ≠ Entry› ‹intra_kind (kind a)› wf
have "c⇩1;; prog,procs ⊢ (Main, n ⊕ #:c⇩1) -kind a→ (Main, nx'' ⊕ #:c⇩1)"
by(fastforce intro:PCFG_Main_edge_SeqSecond_source_not_Entry simp:valid_edge_def)
with path ‹sourcenode a = (Main, n)› ‹targetnode a = n''› ‹n'' = (Main,nx'')›
show ?case apply(cases a) apply(clarsimp simp:label_incrs_def)
by(auto intro:ProcCFG.Cons_path simp:valid_edge_def)
qed
subsubsection ‹From ‹prog› to ‹if (b) prog else c⇩2››
lemma Proc_CFG_edge_CondTrue_source_not_Entry:
"⟦prog ⊢ n -et→⇩p n'; n ≠ Entry⟧ ⟹ if (b) prog else c⇩2 ⊢ n ⊕ 1 -et→⇩p n' ⊕ 1"
by(induct rule:Proc_CFG.induct)(fastforce intro:Proc_CFG_CondThen Proc_CFG.intros)+
lemma PCFG_Main_edge_CondTrue_source_not_Entry:
"⟦prog,procs ⊢ (Main,n) -et→ (p',n'); n ≠ Entry; intra_kind et; well_formed procs⟧
⟹ if (b) prog else c⇩2,procs ⊢ (Main,n ⊕ 1) -et→ (p',n' ⊕ 1)"
proof(induct "(Main,n)" et "(p',n')" rule:PCFG.induct)
case Main
thus ?case by(fastforce dest:Proc_CFG_edge_CondTrue_source_not_Entry intro:PCFG.Main)
next
case (MainCallReturn p es rets)
from ‹prog ⊢ n -CEdge (p, es, rets)→⇩p n'› ‹n ≠ Entry›
have "if (b) prog else c⇩2 ⊢ n ⊕ 1 -CEdge (p, es, rets)→⇩p n' ⊕ 1"
by(rule Proc_CFG_edge_CondTrue_source_not_Entry)
with MainCallReturn show ?case by(fastforce intro:PCFG.MainCallReturn)
qed (auto simp:intra_kind_def)
lemma valid_node_Main_CondTrue:
assumes "CFG.valid_node sourcenode targetnode (valid_edge wfp) (Main,n)"
and "n ≠ Entry" and "Rep_wf_prog wfp = (prog,procs)"
and "Rep_wf_prog wfp' = (if (b) prog else c⇩2,procs)"
shows "CFG.valid_node sourcenode targetnode (valid_edge wfp') (Main, n ⊕ 1)"
proof -
note [simp] = ‹Rep_wf_prog wfp = (prog,procs)›
‹Rep_wf_prog wfp' = (if (b) prog else c⇩2,procs)›
from ‹Rep_wf_prog wfp = (prog,procs)› have wf:"well_formed procs"
by(fastforce intro:wf_wf_prog)
from ‹CFG.valid_node sourcenode targetnode (valid_edge wfp) (Main,n)›
obtain a where "prog,procs ⊢ sourcenode a -kind a→ targetnode a"
and "(Main,n) = sourcenode a ∨ (Main,n) = targetnode a"
by(fastforce simp:ProcCFG.valid_node_def valid_edge_def)
from this ‹n ≠ Entry› wf show ?thesis
proof(induct "sourcenode a" "kind a" "targetnode a" rule:PCFG.induct)
case (Main nx nx')
from ‹(Main,n) = sourcenode a ∨ (Main,n) = targetnode a› show ?case
proof
assume "(Main,n) = sourcenode a"
with ‹(Main, nx) = sourcenode a›[THEN sym] have [simp]:"nx = n" by simp
from ‹n ≠ Entry› ‹prog ⊢ nx -IEdge (kind a)→⇩p nx'›
have "if (b) prog else c⇩2 ⊢ n ⊕ 1 -IEdge (kind a)→⇩p nx' ⊕ 1"
by(fastforce intro:Proc_CFG_edge_CondTrue_source_not_Entry)
hence "if (b) prog else c⇩2,procs ⊢ (Main,n ⊕ 1) -kind a→ (Main,nx' ⊕ 1)"
by(rule PCFG.Main)
thus ?thesis by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
next
assume "(Main, n) = targetnode a"
show ?thesis
proof(cases "nx = Entry")
case True
with ‹prog ⊢ nx -IEdge (kind a)→⇩p nx'›
have "nx' = Exit ∨ nx' = Label 0" by(fastforce dest:Proc_CFG_EntryD)
thus ?thesis
proof
assume "nx' = Exit"
with ‹(Main, n) = targetnode a› ‹(Main, nx') = targetnode a›[THEN sym]
show ?thesis by simp
next
assume "nx' = Label 0"
have "if (b) prog else c⇩2 ⊢ Label 0
-IEdge (λcf. state_check cf b (Some true))⇩√→⇩p Label 1"
by(rule Proc_CFG_CondTrue)
with ‹nx' = Label 0›
have "if (b) prog else c⇩2,procs ⊢ (Main,Label 0)
-(λcf. state_check cf b (Some true))⇩√→ (Main,nx' ⊕ 1)"
by(fastforce intro:PCFG.Main)
with ‹(Main, n) = targetnode a› ‹(Main, nx') = targetnode a›[THEN sym]
show ?thesis
by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
qed
next
case False
with ‹prog ⊢ nx -IEdge (kind a)→⇩p nx'›
have "if (b) prog else c⇩2 ⊢ nx ⊕ 1 -IEdge (kind a)→⇩p nx' ⊕ 1"
by(fastforce intro:Proc_CFG_edge_CondTrue_source_not_Entry)
hence "if (b) prog else c⇩2,procs ⊢ (Main,nx ⊕ 1) -kind a→
(Main,nx' ⊕ 1)" by(rule PCFG.Main)
with ‹(Main, n) = targetnode a› ‹(Main, nx') = targetnode a›[THEN sym]
show ?thesis by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
qed
qed
next
case (Proc p ins outs c nx n' ps)
from ‹(p, nx) = sourcenode a›[THEN sym] ‹(p, n') = targetnode a›[THEN sym]
‹(p, ins, outs, c) ∈ set procs› ‹well_formed procs›
‹(Main, n) = sourcenode a ∨ (Main, n) = targetnode a›
have False by fastforce
thus ?case by simp
next
case (MainCall l p es rets n' ins outs c)
from ‹(p, ins, outs, c) ∈ set procs› ‹(p, Entry) = targetnode a›[THEN sym]
‹(Main, Label l) = sourcenode a›[THEN sym] wf
‹(Main, n) = sourcenode a ∨ (Main, n) = targetnode a›
have [simp]:"n = Label l" by fastforce
from ‹prog ⊢ Label l -CEdge (p, es, rets)→⇩p n'›
have "if (b) prog else c⇩2 ⊢ Label l ⊕ 1 -CEdge (p, es, rets)→⇩p n' ⊕ 1"
by -(rule Proc_CFG_edge_CondTrue_source_not_Entry,auto)
with ‹(p, ins, outs, c) ∈ set procs›
have "if (b) prog else c⇩2,procs ⊢ (Main,Label (l + 1))
-(λs. True):(Main,n' ⊕ 1)↪⇘p⇙map (λe cf. interpret e cf) es→ (p,Entry)"
by(fastforce intro:PCFG.MainCall)
thus ?case by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
next
case (ProcCall p ins outs c l p' es' rets' l' ins' outs' c' ps)
from ‹(p, Label l) = sourcenode a›[THEN sym]
‹(p', Entry) = targetnode a›[THEN sym] ‹well_formed procs›
‹(p, ins, outs, c) ∈ set procs› ‹(p', ins', outs', c') ∈ set procs›
‹(Main, n) = sourcenode a ∨ (Main, n) = targetnode a›
have False by fastforce
thus ?case by simp
next
case (MainReturn l p es rets l' ins outs c)
from ‹(p, ins, outs, c) ∈ set procs› ‹(p, Exit) = sourcenode a›[THEN sym]
‹(Main, Label l') = targetnode a›[THEN sym] wf
‹(Main, n) = sourcenode a ∨ (Main, n) = targetnode a›
have [simp]:"n = Label l'" by fastforce
from ‹prog ⊢ Label l -CEdge (p, es, rets)→⇩p Label l'›
have "if (b) prog else c⇩2 ⊢ Label l ⊕ 1 -CEdge (p, es, rets)→⇩p Label l' ⊕ 1"
by -(rule Proc_CFG_edge_CondTrue_source_not_Entry,auto)
with ‹(p, ins, outs, c) ∈ set procs›
have "if (b) prog else c⇩2,procs ⊢ (p,Exit) -(λcf. snd cf = (Main,Label l' ⊕ 1))↩⇘p⇙
(λcf cf'. cf'(rets [:=] map cf outs))→ (Main,Label (l' + 1))"
by(fastforce intro:PCFG.MainReturn)
thus ?case by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
next
case (ProcReturn p ins outs c l p' es' rets' l' ins' outs' c' ps)
from ‹(p', Exit) = sourcenode a›[THEN sym]
‹(p, Label l') = targetnode a›[THEN sym] ‹well_formed procs›
‹(p, ins, outs, c) ∈ set procs› ‹(p', ins', outs', c') ∈ set procs›
‹(Main, n) = sourcenode a ∨ (Main, n) = targetnode a›
have False by fastforce
thus ?case by simp
next
case (MainCallReturn nx p es rets nx')
from ‹(Main,n) = sourcenode a ∨ (Main,n) = targetnode a› show ?case
proof
assume "(Main,n) = sourcenode a"
with ‹(Main, nx) = sourcenode a›[THEN sym] have [simp]:"nx = n" by simp
from ‹n ≠ Entry› ‹prog ⊢ nx -CEdge (p, es, rets)→⇩p nx'›
have "if (b) prog else c⇩2 ⊢ n ⊕ 1 -CEdge (p, es, rets)→⇩p nx' ⊕ 1"
by(fastforce intro:Proc_CFG_edge_CondTrue_source_not_Entry)
hence "if (b) prog else c⇩2,procs ⊢ (Main,n ⊕ 1) -(λs. False)⇩√→
(Main,nx' ⊕ 1)" by -(rule PCFG.MainCallReturn)
thus ?thesis by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
next
assume "(Main, n) = targetnode a"
from ‹prog ⊢ nx -CEdge (p, es, rets)→⇩p nx'›
have "nx ≠ Entry" by(fastforce dest:Proc_CFG_Call_Labels)
with ‹prog ⊢ nx -CEdge (p, es, rets)→⇩p nx'›
have "if (b) prog else c⇩2 ⊢ nx ⊕ 1 -CEdge (p, es, rets)→⇩p nx' ⊕ 1"
by(fastforce intro:Proc_CFG_edge_CondTrue_source_not_Entry)
hence "if (b) prog else c⇩2,procs ⊢ (Main,nx ⊕ 1) -(λs. False)⇩√→ (Main,nx' ⊕ 1)"
by -(rule PCFG.MainCallReturn)
with ‹(Main, n) = targetnode a› ‹(Main, nx') = targetnode a›[THEN sym]
show ?thesis by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
qed
next
case (ProcCallReturn p ins outs c nx p' es' rets' n' ps)
from ‹(p, nx) = sourcenode a›[THEN sym] ‹(p, n') = targetnode a›[THEN sym]
‹(p, ins, outs, c) ∈ set procs› ‹well_formed procs›
‹(Main, n) = sourcenode a ∨ (Main, n) = targetnode a›
have False by fastforce
thus ?case by simp
qed
qed
lemma path_Main_CondTrue:
assumes "Rep_wf_prog wfp = (prog,procs)"
and "Rep_wf_prog wfp' = (if (b) prog else c⇩2,procs)"
shows "⟦wfp ⊢ (Main,n) -as→* (p',n'); ∀a ∈ set as. intra_kind (kind a); n ≠ Entry⟧
⟹ wfp' ⊢ (Main,n ⊕ 1) -as ⊕s 1→* (p',n' ⊕ 1)"
proof(induct "(Main,n)" as "(p',n')" arbitrary:n rule:ProcCFG.path.induct)
case empty_path
from ‹CFG.valid_node sourcenode targetnode (valid_edge wfp) (Main, n')›
‹n' ≠ Entry› ‹Rep_wf_prog wfp = (prog,procs)›
‹Rep_wf_prog wfp' = (if (b) prog else c⇩2,procs)›
have "CFG.valid_node sourcenode targetnode (valid_edge wfp') (Main, n' ⊕ 1)"
by(fastforce intro:valid_node_Main_CondTrue)
with ‹Main = p'› show ?case
by(fastforce intro:ProcCFG.empty_path simp:label_incrs_def)
next
case (Cons_path n'' as a n)
note IH = ‹⋀n. ⟦n'' = (Main, n); ∀a∈set as. intra_kind (kind a); n ≠ Entry⟧
⟹ wfp' ⊢ (Main, n ⊕ 1) -as ⊕s 1→* (p', n' ⊕ 1)›
note [simp] = ‹Rep_wf_prog wfp = (prog,procs)›
‹Rep_wf_prog wfp' = (if (b) prog else c⇩2,procs)›
from ‹Rep_wf_prog wfp = (prog,procs)› have wf:"well_formed procs"
by(fastforce intro:wf_wf_prog)
from ‹∀a∈set (a # as). intra_kind (kind a)› have "intra_kind (kind a)"
and "∀a∈set as. intra_kind (kind a)" by simp_all
from ‹valid_edge wfp a› ‹sourcenode a = (Main, n)› ‹targetnode a = n''›
‹intra_kind (kind a)› wf
obtain nx'' where "n'' = (Main,nx'')" and "nx'' ≠ Entry"
by(auto elim!:PCFG.cases simp:valid_edge_def intra_kind_def)
from IH[OF ‹n'' = (Main,nx'')› ‹∀a∈set as. intra_kind (kind a)› ‹nx'' ≠ Entry›]
have path:"wfp' ⊢ (Main, nx'' ⊕ 1) -as ⊕s 1→* (p', n' ⊕ 1)" .
from ‹valid_edge wfp a› ‹sourcenode a = (Main, n)› ‹targetnode a = n''›
‹n'' = (Main,nx'')› ‹n ≠ Entry› ‹intra_kind (kind a)› wf
have "if (b) prog else c⇩2,procs ⊢ (Main, n ⊕ 1) -kind a→ (Main, nx'' ⊕ 1)"
by(fastforce intro:PCFG_Main_edge_CondTrue_source_not_Entry simp:valid_edge_def)
with path ‹sourcenode a = (Main, n)› ‹targetnode a = n''› ‹n'' = (Main,nx'')›
show ?case
apply(cases a) apply(clarsimp simp:label_incrs_def)
by(auto intro:ProcCFG.Cons_path simp:valid_edge_def)
qed
subsubsection ‹From ‹prog› to ‹if (b) c⇩1 else prog››
lemma Proc_CFG_edge_CondFalse_source_not_Entry:
"⟦prog ⊢ n -et→⇩p n'; n ≠ Entry⟧
⟹ if (b) c⇩1 else prog ⊢ n ⊕ (#:c⇩1 + 1) -et→⇩p n' ⊕ (#:c⇩1 + 1)"
by(induct rule:Proc_CFG.induct)(fastforce intro:Proc_CFG_CondElse Proc_CFG.intros)+
lemma PCFG_Main_edge_CondFalse_source_not_Entry:
"⟦prog,procs ⊢ (Main,n) -et→ (p',n'); n ≠ Entry; intra_kind et; well_formed procs⟧
⟹ if (b) c⇩1 else prog,procs ⊢ (Main,n ⊕ (#:c⇩1 + 1)) -et→ (p',n' ⊕ (#:c⇩1 + 1))"
proof(induct "(Main,n)" et "(p',n')" rule:PCFG.induct)
case Main
thus ?case
by(fastforce dest:Proc_CFG_edge_CondFalse_source_not_Entry intro:PCFG.Main)
next
case (MainCallReturn p es rets)
from ‹prog ⊢ n -CEdge (p, es, rets)→⇩p n'› ‹n ≠ Entry›
have "if (b) c⇩1 else prog ⊢ n ⊕ (#:c⇩1 + 1) -CEdge (p, es, rets)→⇩p n' ⊕ (#:c⇩1 + 1)"
by(rule Proc_CFG_edge_CondFalse_source_not_Entry)
with MainCallReturn show ?case by(fastforce intro:PCFG.MainCallReturn)
qed (auto simp:intra_kind_def)
lemma valid_node_Main_CondFalse:
assumes "CFG.valid_node sourcenode targetnode (valid_edge wfp) (Main,n)"
and "n ≠ Entry" and "Rep_wf_prog wfp = (prog,procs)"
and "Rep_wf_prog wfp' = (if (b) c⇩1 else prog,procs)"
shows "CFG.valid_node sourcenode targetnode (valid_edge wfp')
(Main, n ⊕ (#:c⇩1 + 1))"
proof -
note [simp] = ‹Rep_wf_prog wfp = (prog,procs)›
‹Rep_wf_prog wfp' = (if (b) c⇩1 else prog,procs)›
from ‹Rep_wf_prog wfp = (prog,procs)› have wf:"well_formed procs"
by(fastforce intro:wf_wf_prog)
from ‹CFG.valid_node sourcenode targetnode (valid_edge wfp) (Main,n)›
obtain a where "prog,procs ⊢ sourcenode a -kind a→ targetnode a"
and "(Main,n) = sourcenode a ∨ (Main,n) = targetnode a"
by(fastforce simp:ProcCFG.valid_node_def valid_edge_def)
from this ‹n ≠ Entry› wf show ?thesis
proof(induct "sourcenode a" "kind a" "targetnode a" rule:PCFG.induct)
case (Main nx nx')
from ‹(Main,n) = sourcenode a ∨ (Main,n) = targetnode a› show ?case
proof
assume "(Main,n) = sourcenode a"
with ‹(Main, nx) = sourcenode a›[THEN sym] have [simp]:"nx = n" by simp
from ‹n ≠ Entry› ‹prog ⊢ nx -IEdge (kind a)→⇩p nx'›
have "if (b) c⇩1 else prog ⊢ n ⊕ (#:c⇩1 + 1) -IEdge (kind a)→⇩p nx' ⊕ (#:c⇩1 + 1)"
by(fastforce intro:Proc_CFG_edge_CondFalse_source_not_Entry)
hence "if (b) c⇩1 else prog,procs ⊢ (Main,n ⊕ (#:c⇩1 + 1)) -kind a→
(Main,nx' ⊕ (#:c⇩1 + 1))" by(rule PCFG.Main)
thus ?thesis by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
next
assume "(Main, n) = targetnode a"
show ?thesis
proof(cases "nx = Entry")
case True
with ‹prog ⊢ nx -IEdge (kind a)→⇩p nx'›
have "nx' = Exit ∨ nx' = Label 0" by(fastforce dest:Proc_CFG_EntryD)
thus ?thesis
proof
assume "nx' = Exit"
with ‹(Main, n) = targetnode a› ‹(Main, nx') = targetnode a›[THEN sym]
show ?thesis by simp
next
assume "nx' = Label 0"
have "if (b) c⇩1 else prog ⊢ Label 0
-IEdge (λcf. state_check cf b (Some false))⇩√→⇩p Label (#:c⇩1 + 1)"
by(rule Proc_CFG_CondFalse)
with ‹nx' = Label 0›
have "if (b) c⇩1 else prog,procs ⊢ (Main,Label 0)
-(λcf. state_check cf b (Some false))⇩√→ (Main,nx' ⊕ (#:c⇩1 + 1))"
by(fastforce intro:PCFG.Main)
with ‹(Main, n) = targetnode a› ‹(Main, nx') = targetnode a›[THEN sym]
show ?thesis
by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
qed
next
case False
with ‹prog ⊢ nx -IEdge (kind a)→⇩p nx'›
have "if (b) c⇩1 else prog ⊢ nx ⊕ (#:c⇩1 + 1) -IEdge (kind a)→⇩p nx' ⊕ (#:c⇩1 + 1)"
by(fastforce intro:Proc_CFG_edge_CondFalse_source_not_Entry)
hence "if (b) c⇩1 else prog,procs ⊢ (Main,nx ⊕ (#:c⇩1 + 1)) -kind a→
(Main,nx' ⊕ (#:c⇩1 + 1))" by(rule PCFG.Main)
with ‹(Main, n) = targetnode a› ‹(Main, nx') = targetnode a›[THEN sym]
show ?thesis by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
qed
qed
next
case (Proc p ins outs c nx n' ps)
from ‹(p, nx) = sourcenode a›[THEN sym] ‹(p, n') = targetnode a›[THEN sym]
‹(p, ins, outs, c) ∈ set procs› ‹well_formed procs›
‹(Main, n) = sourcenode a ∨ (Main, n) = targetnode a›
have False by fastforce
thus ?case by simp
next
case (MainCall l p es rets n' ins outs c)
from ‹(p, ins, outs, c) ∈ set procs› ‹(p, Entry) = targetnode a›[THEN sym]
‹(Main, Label l) = sourcenode a›[THEN sym] wf
‹(Main, n) = sourcenode a ∨ (Main, n) = targetnode a›
have [simp]:"n = Label l" by fastforce
from ‹prog ⊢ Label l -CEdge (p, es, rets)→⇩p n'›
have "if (b) c⇩1 else prog ⊢ Label l ⊕ (#:c⇩1 + 1) -CEdge (p, es, rets)→⇩p
n' ⊕ (#:c⇩1 + 1)" by -(rule Proc_CFG_edge_CondFalse_source_not_Entry,auto)
with ‹(p, ins, outs, c) ∈ set procs›
have "if (b) c⇩1 else prog,procs ⊢ (Main,Label (l + (#:c⇩1 + 1)))
-(λs. True):(Main,n' ⊕ (#:c⇩1 + 1))↪⇘p⇙map (λe cf. interpret e cf) es→ (p,Entry)"
by(fastforce intro:PCFG.MainCall)
thus ?case by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
next
case (ProcCall p ins outs c l p' es' rets' l' ins' outs' c' ps)
from ‹(p, Label l) = sourcenode a›[THEN sym]
‹(p', Entry) = targetnode a›[THEN sym] ‹well_formed procs›
‹(p, ins, outs, c) ∈ set procs› ‹(p', ins', outs', c') ∈ set procs›
‹(Main, n) = sourcenode a ∨ (Main, n) = targetnode a›
have False by fastforce
thus ?case by simp
next
case (MainReturn l p es rets l' ins outs c)
from ‹(p, ins, outs, c) ∈ set procs› ‹(p, Exit) = sourcenode a›[THEN sym]
‹(Main, Label l') = targetnode a›[THEN sym] wf
‹(Main, n) = sourcenode a ∨ (Main, n) = targetnode a›
have [simp]:"n = Label l'" by fastforce
from ‹prog ⊢ Label l -CEdge (p, es, rets)→⇩p Label l'›
have "if (b) c⇩1 else prog ⊢ Label l ⊕ (#:c⇩1 + 1) -CEdge (p, es, rets)→⇩p
Label l' ⊕ (#:c⇩1 + 1)" by -(rule Proc_CFG_edge_CondFalse_source_not_Entry,auto)
with ‹(p, ins, outs, c) ∈ set procs›
have "if (b) c⇩1 else prog,procs ⊢ (p,Exit)
-(λcf. snd cf = (Main,Label l' ⊕ (#:c⇩1 + 1)))↩⇘p⇙
(λcf cf'. cf'(rets [:=] map cf outs))→ (Main,Label (l' + (#:c⇩1 + 1)))"
by(fastforce intro:PCFG.MainReturn)
thus ?case by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
next
case (ProcReturn p ins outs c l p' es' rets' l' ins' outs' c' ps)
from ‹(p', Exit) = sourcenode a›[THEN sym]
‹(p, Label l') = targetnode a›[THEN sym] ‹well_formed procs›
‹(p, ins, outs, c) ∈ set procs› ‹(p', ins', outs', c') ∈ set procs›
‹(Main, n) = sourcenode a ∨ (Main, n) = targetnode a›
have False by fastforce
thus ?case by simp
next
case (MainCallReturn nx p es rets nx')
from ‹(Main,n) = sourcenode a ∨ (Main,n) = targetnode a› show ?case
proof
assume "(Main,n) = sourcenode a"
with ‹(Main, nx) = sourcenode a›[THEN sym] have [simp]:"nx = n" by simp
from ‹n ≠ Entry› ‹prog ⊢ nx -CEdge (p, es, rets)→⇩p nx'›
have "if (b) c⇩1 else prog ⊢ n ⊕ (#:c⇩1 + 1) -CEdge (p, es, rets)→⇩p
nx' ⊕ (#:c⇩1 + 1)" by(fastforce intro:Proc_CFG_edge_CondFalse_source_not_Entry)
hence "if (b) c⇩1 else prog,procs ⊢ (Main,n ⊕ (#:c⇩1 + 1))
-(λs. False)⇩√→ (Main,nx' ⊕ (#:c⇩1 + 1))" by -(rule PCFG.MainCallReturn)
thus ?thesis by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
next
assume "(Main, n) = targetnode a"
from ‹prog ⊢ nx -CEdge (p, es, rets)→⇩p nx'›
have "nx ≠ Entry" by(fastforce dest:Proc_CFG_Call_Labels)
with ‹prog ⊢ nx -CEdge (p, es, rets)→⇩p nx'›
have "if (b) c⇩1 else prog ⊢ nx ⊕ (#:c⇩1 + 1) -CEdge (p, es, rets)→⇩p
nx' ⊕ (#:c⇩1 + 1)" by(fastforce intro:Proc_CFG_edge_CondFalse_source_not_Entry)
hence "if (b) c⇩1 else prog,procs ⊢ (Main,nx ⊕ (#:c⇩1 + 1))
-(λs. False)⇩√→ (Main,nx' ⊕ (#:c⇩1 + 1))" by -(rule PCFG.MainCallReturn)
with ‹(Main, n) = targetnode a› ‹(Main, nx') = targetnode a›[THEN sym]
show ?thesis by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
qed
next
case (ProcCallReturn p ins outs c nx p' es' rets' n' ps)
from ‹(p, nx) = sourcenode a›[THEN sym] ‹(p, n') = targetnode a›[THEN sym]
‹(p, ins, outs, c) ∈ set procs› ‹well_formed procs›
‹(Main, n) = sourcenode a ∨ (Main, n) = targetnode a›
have False by fastforce
thus ?case by simp
qed
qed
lemma path_Main_CondFalse:
assumes "Rep_wf_prog wfp = (prog,procs)"
and "Rep_wf_prog wfp' = (if (b) c⇩1 else prog,procs)"
shows "⟦wfp ⊢ (Main,n) -as→* (p',n'); ∀a ∈ set as. intra_kind (kind a); n ≠ Entry⟧
⟹ wfp' ⊢ (Main,n ⊕ (#:c⇩1 + 1)) -as ⊕s (#:c⇩1 + 1)→* (p',n' ⊕ (#:c⇩1 + 1))"
proof(induct "(Main,n)" as "(p',n')" arbitrary:n rule:ProcCFG.path.induct)
case empty_path
from ‹CFG.valid_node sourcenode targetnode (valid_edge wfp) (Main, n')›
‹n' ≠ Entry› ‹Rep_wf_prog wfp = (prog,procs)›
‹Rep_wf_prog wfp' = (if (b) c⇩1 else prog,procs)›
have "CFG.valid_node sourcenode targetnode (valid_edge wfp') (Main, n' ⊕ (#:c⇩1 + 1))"
by(fastforce intro:valid_node_Main_CondFalse)
with ‹Main = p'› show ?case
by(fastforce intro:ProcCFG.empty_path simp:label_incrs_def)
next
case (Cons_path n'' as a n)
note IH = ‹⋀n. ⋀n. ⟦n'' = (Main, n); ∀a∈set as. intra_kind (kind a); n ≠ Entry⟧
⟹ wfp' ⊢ (Main, n ⊕ (#:c⇩1 + 1)) -as ⊕s (#:c⇩1 + 1)→* (p', n' ⊕ (#:c⇩1 + 1))›
note [simp] = ‹Rep_wf_prog wfp = (prog,procs)›
‹Rep_wf_prog wfp' = (if (b) c⇩1 else prog,procs)›
from ‹Rep_wf_prog wfp = (prog,procs)› have wf:"well_formed procs"
by(fastforce intro:wf_wf_prog)
from ‹∀a∈set (a # as). intra_kind (kind a)› have "intra_kind (kind a)"
and "∀a∈set as. intra_kind (kind a)" by simp_all
from ‹valid_edge wfp a› ‹sourcenode a = (Main, n)› ‹targetnode a = n''›
‹intra_kind (kind a)› wf
obtain nx'' where "n'' = (Main,nx'')" and "nx'' ≠ Entry"
by(auto elim!:PCFG.cases simp:valid_edge_def intra_kind_def)
from IH[OF ‹n'' = (Main,nx'')› ‹∀a∈set as. intra_kind (kind a)› ‹nx'' ≠ Entry›]
have path:"wfp' ⊢ (Main, nx'' ⊕ (#:c⇩1 + 1)) -as ⊕s (#:c⇩1 + 1)→*
(p', n' ⊕ (#:c⇩1 + 1))" .
from ‹valid_edge wfp a› ‹sourcenode a = (Main, n)› ‹targetnode a = n''›
‹n'' = (Main,nx'')› ‹n ≠ Entry› ‹intra_kind (kind a)› wf
have "if (b) c⇩1 else prog,procs ⊢ (Main, n ⊕ (#:c⇩1 + 1)) -kind a→
(Main, nx'' ⊕ (#:c⇩1 + 1))"
by(fastforce intro:PCFG_Main_edge_CondFalse_source_not_Entry simp:valid_edge_def)
with path ‹sourcenode a = (Main, n)› ‹targetnode a = n''› ‹n'' = (Main,nx'')›
show ?case
apply(cases a) apply(clarsimp simp:label_incrs_def)
by(auto intro:ProcCFG.Cons_path simp:valid_edge_def)
qed
subsubsection ‹From ‹prog› to ‹while (b) prog››
lemma Proc_CFG_edge_WhileBody_source_not_Entry:
"⟦prog ⊢ n -et→⇩p n'; n ≠ Entry; n' ≠ Exit⟧
⟹ while (b) prog ⊢ n ⊕ 2 -et→⇩p n' ⊕ 2"
by(induct rule:Proc_CFG.induct)(fastforce intro:Proc_CFG_WhileBody Proc_CFG.intros)+
lemma PCFG_Main_edge_WhileBody_source_not_Entry:
"⟦prog,procs ⊢ (Main,n) -et→ (p',n'); n ≠ Entry; n' ≠ Exit; intra_kind et;
well_formed procs⟧ ⟹ while (b) prog,procs ⊢ (Main,n ⊕ 2) -et→ (p',n' ⊕ 2)"
proof(induct "(Main,n)" et "(p',n')" rule:PCFG.induct)
case Main
thus ?case
by(fastforce dest:Proc_CFG_edge_WhileBody_source_not_Entry intro:PCFG.Main)
next
case (MainCallReturn p es rets)
from ‹prog ⊢ n -CEdge (p, es, rets)→⇩p n'› ‹n ≠ Entry› ‹n' ≠ Exit›
have "while (b) prog ⊢ n ⊕ 2 -CEdge (p, es, rets)→⇩p n' ⊕ 2"
by(rule Proc_CFG_edge_WhileBody_source_not_Entry)
with MainCallReturn show ?case by(fastforce intro:PCFG.MainCallReturn)
qed (auto simp:intra_kind_def)
lemma valid_node_Main_WhileBody:
assumes "CFG.valid_node sourcenode targetnode (valid_edge wfp) (Main,n)"
and "n ≠ Entry" and "Rep_wf_prog wfp = (prog,procs)"
and "Rep_wf_prog wfp' = (while (b) prog,procs)"
shows "CFG.valid_node sourcenode targetnode (valid_edge wfp') (Main, n ⊕ 2)"
proof -
note [simp] = ‹Rep_wf_prog wfp = (prog,procs)›
‹Rep_wf_prog wfp' = (while (b) prog,procs)›
from ‹Rep_wf_prog wfp = (prog,procs)› have wf:"well_formed procs"
by(fastforce intro:wf_wf_prog)
from ‹CFG.valid_node sourcenode targetnode (valid_edge wfp) (Main,n)›
obtain a where "prog,procs ⊢ sourcenode a -kind a→ targetnode a"
and "(Main,n) = sourcenode a ∨ (Main,n) = targetnode a"
by(fastforce simp:ProcCFG.valid_node_def valid_edge_def)
from this ‹n ≠ Entry› wf show ?thesis
proof(induct "sourcenode a" "kind a" "targetnode a" rule:PCFG.induct)
case (Main nx nx')
from ‹(Main,n) = sourcenode a ∨ (Main,n) = targetnode a› show ?case
proof
assume "(Main,n) = sourcenode a"
with ‹(Main, nx) = sourcenode a›[THEN sym] have [simp]:"nx = n" by simp
show ?thesis
proof(cases "nx' = Exit")
case True
with ‹n ≠ Entry› ‹prog ⊢ nx -IEdge (kind a)→⇩p nx'›
have "while (b) prog ⊢ n ⊕ 2 -IEdge (kind a)→⇩p Label 0"
by(fastforce intro:Proc_CFG_WhileBodyExit)
hence "while (b) prog,procs ⊢ (Main,n ⊕ 2) -kind a→ (Main,Label 0)"
by(rule PCFG.Main)
thus ?thesis by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
next
case False
with ‹n ≠ Entry› ‹prog ⊢ nx -IEdge (kind a)→⇩p nx'›
have "while (b) prog ⊢ n ⊕ 2 -IEdge (kind a)→⇩p nx' ⊕ 2"
by(fastforce intro:Proc_CFG_edge_WhileBody_source_not_Entry)
hence "while (b) prog,procs ⊢ (Main,n ⊕ 2) -kind a→ (Main,nx' ⊕ 2)"
by(rule PCFG.Main)
thus ?thesis by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
qed
next
assume "(Main, n) = targetnode a"
show ?thesis
proof(cases "nx = Entry")
case True
with ‹prog ⊢ nx -IEdge (kind a)→⇩p nx'›
have "nx' = Exit ∨ nx' = Label 0" by(fastforce dest:Proc_CFG_EntryD)
thus ?thesis
proof
assume "nx' = Exit"
with ‹(Main, n) = targetnode a› ‹(Main, nx') = targetnode a›[THEN sym]
show ?thesis by simp
next
assume "nx' = Label 0"
have "while (b) prog ⊢ Label 0
-IEdge (λcf. state_check cf b (Some true))⇩√→⇩p Label 2"
by(rule Proc_CFG_WhileTrue)
hence "while (b) prog,procs ⊢ (Main,Label 0)
-(λcf. state_check cf b (Some true))⇩√→ (Main,Label 2)"
by(fastforce intro:PCFG.Main)
with ‹(Main, n) = targetnode a› ‹(Main, nx') = targetnode a›[THEN sym]
‹nx' = Label 0› show ?thesis
by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
qed
next
case False
show ?thesis
proof(cases "nx' = Exit")
case True
with ‹(Main, n) = targetnode a› ‹(Main, nx') = targetnode a›[THEN sym]
show ?thesis by simp
next
case False
with ‹prog ⊢ nx -IEdge (kind a)→⇩p nx'› ‹nx ≠ Entry›
have "while (b) prog ⊢ nx ⊕ 2 -IEdge (kind a)→⇩p nx' ⊕ 2"
by(fastforce intro:Proc_CFG_edge_WhileBody_source_not_Entry)
hence "while (b) prog,procs ⊢ (Main,nx ⊕ 2) -kind a→
(Main,nx' ⊕ 2)" by(rule PCFG.Main)
with ‹(Main, n) = targetnode a› ‹(Main, nx') = targetnode a›[THEN sym]
show ?thesis
by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
qed
qed
qed
next
case (Proc p ins outs c nx n' ps)
from ‹(p, nx) = sourcenode a›[THEN sym] ‹(p, n') = targetnode a›[THEN sym]
‹(Main, n) = sourcenode a ∨ (Main, n) = targetnode a›
‹(p, ins, outs, c) ∈ set procs› ‹well_formed procs›
have False by fastforce
thus ?case by simp
next
case (MainCall l p es rets n' ins outs c)
from ‹(p, ins, outs, c) ∈ set procs› ‹(p, Entry) = targetnode a›[THEN sym]
‹(Main, Label l) = sourcenode a›[THEN sym] wf
‹(Main, n) = sourcenode a ∨ (Main, n) = targetnode a›
have [simp]:"n = Label l" by fastforce
from ‹prog ⊢ Label l -CEdge (p, es, rets)→⇩p n'› have "n' ≠ Exit"
by(fastforce dest:Proc_CFG_Call_Labels)
with ‹prog ⊢ Label l -CEdge (p, es, rets)→⇩p n'›
have "while (b) prog ⊢ Label l ⊕ 2 -CEdge (p, es, rets)→⇩p
n' ⊕ 2" by -(rule Proc_CFG_edge_WhileBody_source_not_Entry,auto)
with ‹(p, ins, outs, c) ∈ set procs›
have "while (b) prog,procs ⊢ (Main,Label l ⊕ 2)
-(λs. True):(Main,n' ⊕ 2)↪⇘p⇙map (λe cf. interpret e cf) es→ (p,Entry)"
by(fastforce intro:PCFG.MainCall)
thus ?case by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
next
case (ProcCall p ins outs c l p' es' rets' l' ins' outs' c')
from ‹(p, Label l) = sourcenode a›[THEN sym]
‹(p', Entry) = targetnode a›[THEN sym] ‹well_formed procs›
‹(p, ins, outs, c) ∈ set procs› ‹(p', ins', outs', c') ∈ set procs›
‹(Main, n) = sourcenode a ∨ (Main, n) = targetnode a›
have False by fastforce
thus ?case by simp
next
case (MainReturn l p es rets l' ins outs c)
from ‹(p, ins, outs, c) ∈ set procs› ‹(p, Exit) = sourcenode a›[THEN sym]
‹(Main, Label l') = targetnode a›[THEN sym] wf
‹(Main, n) = sourcenode a ∨ (Main, n) = targetnode a›
have [simp]:"n = Label l'" by fastforce
from ‹prog ⊢ Label l -CEdge (p, es, rets)→⇩p Label l'›
have "while (b) prog ⊢ Label l ⊕ 2 -CEdge (p, es, rets)→⇩p
Label l' ⊕ 2" by -(rule Proc_CFG_edge_WhileBody_source_not_Entry,auto)
with ‹(p, ins, outs, c) ∈ set procs›
have "while (b) prog,procs ⊢ (p,Exit) -(λcf. snd cf = (Main,Label l' ⊕ 2))↩⇘p⇙
(λcf cf'. cf'(rets [:=] map cf outs))→ (Main,Label l' ⊕ 2)"
by(fastforce intro:PCFG.MainReturn)
thus ?case by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
next
case (ProcReturn p ins outs c l p' es' rets' l' ins' outs' c' ps)
from ‹(p', Exit) = sourcenode a›[THEN sym]
‹(p, Label l') = targetnode a›[THEN sym] ‹well_formed procs›
‹(p, ins, outs, c) ∈ set procs› ‹(p', ins', outs', c') ∈ set procs›
‹(Main, n) = sourcenode a ∨ (Main, n) = targetnode a›
have False by fastforce
thus ?case by simp
next
case (MainCallReturn nx p es rets nx')
from ‹(Main,n) = sourcenode a ∨ (Main,n) = targetnode a› show ?case
proof
assume "(Main,n) = sourcenode a"
with ‹(Main, nx) = sourcenode a›[THEN sym] have [simp]:"nx = n" by simp
from ‹prog ⊢ nx -CEdge (p, es, rets)→⇩p nx'› have "nx' ≠ Exit"
by(fastforce dest:Proc_CFG_Call_Labels)
with ‹n ≠ Entry› ‹prog ⊢ nx -CEdge (p, es, rets)→⇩p nx'›
have "while (b) prog ⊢ n ⊕ 2 -CEdge (p, es, rets)→⇩p
nx' ⊕ 2" by(fastforce intro:Proc_CFG_edge_WhileBody_source_not_Entry)
hence "while (b) prog,procs ⊢ (Main,n ⊕ 2) -(λs. False)⇩√→ (Main,nx' ⊕ 2)"
by -(rule PCFG.MainCallReturn)
thus ?thesis by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
next
assume "(Main, n) = targetnode a"
from ‹prog ⊢ nx -CEdge (p, es, rets)→⇩p nx'›
have "nx ≠ Entry" and "nx' ≠ Exit" by(auto dest:Proc_CFG_Call_Labels)
with ‹prog ⊢ nx -CEdge (p, es, rets)→⇩p nx'›
have "while (b) prog ⊢ nx ⊕ 2 -CEdge (p, es, rets)→⇩p
nx' ⊕ 2" by(fastforce intro:Proc_CFG_edge_WhileBody_source_not_Entry)
hence "while (b) prog,procs ⊢ (Main,nx ⊕ 2) -(λs. False)⇩√→ (Main,nx' ⊕ 2)"
by -(rule PCFG.MainCallReturn)
with ‹(Main, n) = targetnode a› ‹(Main, nx') = targetnode a›[THEN sym]
show ?thesis by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
qed
next
case (ProcCallReturn p ins outs c nx p' es' rets' n' ps)
from ‹(p, nx) = sourcenode a›[THEN sym] ‹(p, n') = targetnode a›[THEN sym]
‹(p, ins, outs, c) ∈ set procs› ‹well_formed procs›
‹(Main, n) = sourcenode a ∨ (Main, n) = targetnode a›
have False by fastforce
thus ?case by simp
qed
qed
lemma path_Main_WhileBody:
assumes "Rep_wf_prog wfp = (prog,procs)"
and "Rep_wf_prog wfp' = (while (b) prog,procs)"
shows "⟦wfp ⊢ (Main,n) -as→* (p',n'); ∀a ∈ set as. intra_kind (kind a);
n ≠ Entry; n' ≠ Exit⟧ ⟹ wfp' ⊢ (Main,n ⊕ 2) -as ⊕s 2→* (p',n' ⊕ 2)"
proof(induct "(Main,n)" as "(p',n')" arbitrary:n rule:ProcCFG.path.induct)
case empty_path
from ‹CFG.valid_node sourcenode targetnode (valid_edge wfp) (Main, n')›
‹n' ≠ Entry› ‹Rep_wf_prog wfp = (prog,procs)›
‹Rep_wf_prog wfp' = (while (b) prog,procs)›
have "CFG.valid_node sourcenode targetnode (valid_edge wfp') (Main, n' ⊕ 2)"
by(fastforce intro:valid_node_Main_WhileBody)
with ‹Main = p'› show ?case
by(fastforce intro:ProcCFG.empty_path simp:label_incrs_def)
next
case (Cons_path n'' as a n)
note IH = ‹⋀n. ⟦n'' = (Main, n); ∀a∈set as. intra_kind (kind a); n ≠ Entry;
n' ≠ Exit⟧ ⟹ wfp' ⊢ (Main, n ⊕ 2) -as ⊕s 2→* (p', n' ⊕ 2)›
note [simp] = ‹Rep_wf_prog wfp = (prog,procs)›
‹Rep_wf_prog wfp' = (while (b) prog,procs)›
from ‹Rep_wf_prog wfp = (prog,procs)› have wf:"well_formed procs"
by(fastforce intro:wf_wf_prog)
from ‹∀a∈set (a # as). intra_kind (kind a)› have "intra_kind (kind a)"
and "∀a∈set as. intra_kind (kind a)" by simp_all
from ‹valid_edge wfp a› ‹sourcenode a = (Main, n)› ‹targetnode a = n''›
‹intra_kind (kind a)› wf
obtain nx'' where "n'' = (Main,nx'')" and "nx'' ≠ Entry"
by(auto elim!:PCFG.cases simp:valid_edge_def intra_kind_def)
from IH[OF ‹n'' = (Main,nx'')› ‹∀a∈set as. intra_kind (kind a)›
‹nx'' ≠ Entry› ‹n' ≠ Exit›]
have path:"wfp' ⊢ (Main, nx'' ⊕ 2) -as ⊕s 2→* (p', n' ⊕ 2)" .
with ‹n' ≠ Exit› have "nx'' ≠ Exit" by(fastforce dest:ProcCFGExit.path_Exit_source)
with ‹valid_edge wfp a› ‹sourcenode a = (Main, n)› ‹targetnode a = n''›
‹n'' = (Main,nx'')› ‹n ≠ Entry› ‹intra_kind (kind a)› wf
have "while (b) prog,procs ⊢ (Main, n ⊕ 2) -kind a→ (Main, nx'' ⊕ 2)"
by(fastforce intro:PCFG_Main_edge_WhileBody_source_not_Entry simp:valid_edge_def)
with path ‹sourcenode a = (Main, n)› ‹targetnode a = n''› ‹n'' = (Main,nx'')›
show ?case
apply(cases a) apply(clarsimp simp:label_incrs_def)
by(auto intro:ProcCFG.Cons_path simp:valid_edge_def)
qed
subsubsection ‹Existence of intraprodecural paths›
lemma Label_Proc_CFG_Entry_Exit_path_Main:
assumes "Rep_wf_prog wfp = (prog,procs)" and "l < #:prog"
obtains as as' where "wfp ⊢ (Main,Label l) -as→* (Main,Exit)"
and "∀a ∈ set as. intra_kind (kind a)"
and "wfp ⊢ (Main,Entry) -as'→* (Main,Label l)"
and "∀a ∈ set as'. intra_kind (kind a)"
proof(atomize_elim)
from ‹Rep_wf_prog wfp = (prog,procs)› have wf:"well_formed procs"
by(fastforce intro:wf_wf_prog)
from ‹l < #:prog› ‹Rep_wf_prog wfp = (prog,procs)›
show "∃as as'. wfp ⊢ (Main, Label l) -as→* (Main, Exit) ∧
(∀a∈set as. intra_kind (kind a)) ∧
wfp ⊢ (Main, Entry) -as'→* (Main, Label l) ∧ (∀a∈set as'. intra_kind (kind a))"
proof(induct prog arbitrary:l wfp)
case Skip
note [simp] = ‹Rep_wf_prog wfp = (Skip, procs)›
from ‹l < #:Skip› have [simp]:"l = 0" by simp
have "wfp ⊢ (Main,Entry) -[((Main,Entry),(λs. True)⇩√,(Main,Label 0))]→*
(Main,Label 0)"
by(fastforce intro:ProcCFG.path.intros Main Proc_CFG_Entry
simp:valid_edge_def ProcCFG.valid_node_def)
moreover
have "wfp ⊢ (Main,Label l) -[((Main,Label l),⇑id,(Main,Exit))]→* (Main,Exit)"
by(fastforce intro:ProcCFG.path.intros Main Proc_CFG_Skip simp:valid_edge_def)
ultimately show ?case by(fastforce simp:intra_kind_def)
next
case (LAss V e)
note [simp] = ‹Rep_wf_prog wfp = (V:=e, procs)›
from ‹l < #:V:=e› have "l = 0 ∨ l = 1" by auto
thus ?case
proof
assume [simp]:"l = 0"
have "wfp ⊢ (Main,Entry) -[((Main,Entry),(λs. True)⇩√,(Main,Label 0))]→*
(Main,Label 0)"
by(fastforce intro:ProcCFG.path.intros Main Proc_CFG_Entry
simp:valid_edge_def ProcCFG.valid_node_def)
moreover
have "wfp ⊢ (Main,Label 0)
-((Main,Label 0),⇑(λcf. update cf V e),(Main,Label 1))#
[((Main,Label 1),⇑id,(Main,Exit))]→* (Main,Exit)"
by(fastforce intro:ProcCFG.Cons_path ProcCFG.path.intros Main Proc_CFG_LAss
Proc_CFG_LAssSkip simp:valid_edge_def ProcCFG.valid_node_def)
ultimately show ?thesis by(fastforce simp:intra_kind_def)
next
assume [simp]:"l = 1"
have "wfp ⊢ (Main,Entry) -((Main,Entry),(λs. True)⇩√,(Main,Label 0))#
[((Main,Label 0),⇑(λcf. update cf V e),(Main,Label 1))]→* (Main,Label 1)"
by(fastforce intro:ProcCFG.path.intros Main Proc_CFG_LAss ProcCFG.Cons_path
Main Proc_CFG_Entry simp:ProcCFG.valid_node_def valid_edge_def)
moreover
have "wfp ⊢ (Main,Label 1) -[((Main,Label 1),⇑id,(Main,Exit))]→*
(Main,Exit)" by(fastforce intro:ProcCFG.path.intros Main Proc_CFG_LAssSkip
simp:valid_edge_def ProcCFG.valid_node_def)
ultimately show ?thesis by(fastforce simp:intra_kind_def)
qed
next
case (Seq c⇩1 c⇩2)
note IH1 = ‹⋀l wfp. ⟦l < #:c⇩1; Rep_wf_prog wfp = (c⇩1, procs)⟧ ⟹
∃as as'. wfp ⊢ (Main, Label l) -as→* (Main, Exit) ∧
(∀a∈set as. intra_kind (kind a)) ∧
wfp ⊢ (Main, Entry) -as'→* (Main, Label l) ∧ (∀a∈set as'. intra_kind (kind a))›
note IH2 = ‹⋀l wfp. ⟦l < #:c⇩2; Rep_wf_prog wfp = (c⇩2, procs)⟧ ⟹
∃as as'. wfp ⊢ (Main, Label l) -as→* (Main, Exit) ∧
(∀a∈set as. intra_kind (kind a)) ∧
wfp ⊢ (Main, Entry) -as'→* (Main, Label l) ∧ (∀a∈set as'. intra_kind (kind a))›
note [simp] = ‹Rep_wf_prog wfp = (c⇩1;; c⇩2, procs)›
show ?case
proof(cases "l < #:c⇩1")
case True
from ‹Rep_wf_prog wfp = (c⇩1;; c⇩2, procs)›
obtain wfp' where [simp]:"Rep_wf_prog wfp' = (c⇩1, procs)" by(erule wfp_Seq1)
from IH1[OF True this] obtain as as'
where path1:"wfp' ⊢ (Main, Label l) -as→* (Main, Exit)"
and intra1:"∀a∈set as. intra_kind (kind a)"
and path2:"wfp' ⊢ (Main, Entry) -as'→* (Main, Label l)"
and intra2:"∀a∈set as'. intra_kind (kind a)" by blast
from path1 have "as ≠ []" by(fastforce elim:ProcCFG.path.cases)
then obtain ax asx where [simp]:"as = asx@[ax]"
by(cases as rule:rev_cases) fastforce+
with path1 have "wfp' ⊢ (Main, Label l) -asx→* sourcenode ax"
and "valid_edge wfp' ax" and "targetnode ax = (Main, Exit)"
by(auto elim:ProcCFG.path_split_snoc)
from ‹valid_edge wfp' ax› ‹targetnode ax = (Main, Exit)›
obtain nx where "sourcenode ax = (Main,nx)"
by(fastforce elim:PCFG.cases simp:valid_edge_def)
with ‹wfp' ⊢ (Main, Label l) -asx→* sourcenode ax› have "nx ≠ Entry"
by fastforce
moreover
from ‹valid_edge wfp' ax› ‹sourcenode ax = (Main,nx)› have "nx ≠ Exit"
by(fastforce intro:ProcCFGExit.Exit_source)
ultimately obtain lx where [simp]:"nx = Label lx" by(cases nx) auto
with ‹wfp' ⊢ (Main, Label l) -asx→* sourcenode ax›
‹sourcenode ax = (Main,nx)› intra1
have path3:"wfp ⊢ (Main, Label l) -asx→* (Main, Label lx)"
by -(rule path_SeqFirst,auto)
from ‹valid_edge wfp' ax› ‹targetnode ax = (Main, Exit)›
‹sourcenode ax = (Main,nx)› wf
obtain etx where "c⇩1 ⊢ Label lx -etx→⇩p Exit"
by(fastforce elim!:PCFG.cases simp:valid_edge_def)
then obtain et where [simp]:"etx = IEdge et"
by(cases etx)(auto dest:Proc_CFG_Call_Labels)
with ‹c⇩1 ⊢ Label lx -etx→⇩p Exit› have "intra_kind et"
by(fastforce intro:Proc_CFG_IEdge_intra_kind)
from ‹c⇩1 ⊢ Label lx -etx→⇩p Exit› path3
have path4:"wfp ⊢ (Main, Label l) -asx@
[((Main, Label lx),et,(Main,Label 0 ⊕ #:c⇩1))] →* (Main,Label 0 ⊕ #:c⇩1)"
by(fastforce intro:ProcCFG.path_Append ProcCFG.path.intros Proc_CFG_SeqConnect
Main simp:ProcCFG.valid_node_def valid_edge_def)
from ‹Rep_wf_prog wfp = (c⇩1;; c⇩2, procs)›
obtain wfp'' where [simp]:"Rep_wf_prog wfp'' = (c⇩2, procs)" by(erule wfp_Seq2)
from IH2[OF _ this,of "0"] obtain asx'
where "wfp'' ⊢ (Main, Label 0) -asx'→* (Main, Exit)"
and "∀a∈set asx'. intra_kind (kind a)" by blast
with path4 intra1 ‹intra_kind et› have "wfp ⊢ (Main, Label l)
-(asx@[((Main, Label lx),et,(Main,Label 0 ⊕ #:c⇩1))])@(asx' ⊕s #:c⇩1)→*
(Main, Exit ⊕ #:c⇩1)"
by -(erule ProcCFG.path_Append,rule path_Main_SeqSecond,auto)
moreover
from intra1 ‹intra_kind et› ‹∀a∈set asx'. intra_kind (kind a)›
have "∀a ∈ set ((asx@[((Main, Label lx),et,(Main,Label #:c⇩1))])@(asx' ⊕s #:c⇩1)).
intra_kind (kind a)" by(auto simp:label_incrs_def)
moreover
from path2 intra2 have "wfp ⊢ (Main, Entry) -as'→* (Main, Label l)"
by -(rule path_SeqFirst,auto)
ultimately show ?thesis using ‹∀a∈set as'. intra_kind (kind a)› by fastforce
next
case False
hence "#:c⇩1 ≤ l" by simp
then obtain l' where [simp]:"l = l' + #:c⇩1" and "l' = l - #:c⇩1" by simp
from ‹l < #:c⇩1;; c⇩2› have "l' < #:c⇩2" by simp
from ‹Rep_wf_prog wfp = (c⇩1;; c⇩2, procs)›
obtain wfp' where [simp]:"Rep_wf_prog wfp' = (c⇩2, procs)" by(erule wfp_Seq2)
from IH2[OF ‹l' < #:c⇩2› this] obtain as as'
where path1:"wfp' ⊢ (Main, Label l') -as→* (Main, Exit)"
and intra1:"∀a∈set as. intra_kind (kind a)"
and path2:"wfp' ⊢ (Main, Entry) -as'→* (Main, Label l')"
and intra2:"∀a∈set as'. intra_kind (kind a)" by blast
from path1 intra1
have "wfp ⊢ (Main, Label l' ⊕ #:c⇩1) -as ⊕s #:c⇩1→* (Main, Exit ⊕ #:c⇩1)"
by -(rule path_Main_SeqSecond,auto)
moreover
from path2 have "as' ≠ []" by(fastforce elim:ProcCFG.path.cases)
with path2 obtain ax' asx' where [simp]:"as' = ax'#asx'"
and "sourcenode ax' = (Main, Entry)" and "valid_edge wfp' ax'"
and "wfp' ⊢ targetnode ax' -asx'→* (Main, Label l')"
by -(erule ProcCFG.path_split_Cons,fastforce+)
from ‹wfp' ⊢ targetnode ax' -asx'→* (Main, Label l')›
have "targetnode ax' ≠ (Main,Exit)" by fastforce
with ‹valid_edge wfp' ax'› ‹sourcenode ax' = (Main, Entry)› wf
have "targetnode ax' = (Main,Label 0)"
by(fastforce elim:PCFG.cases dest:Proc_CFG_EntryD simp:valid_edge_def)
with ‹wfp' ⊢ targetnode ax' -asx'→* (Main, Label l')› intra2
have path3:"wfp ⊢ (Main,Label 0 ⊕ #:c⇩1) -asx' ⊕s #:c⇩1→*
(Main, Label l' ⊕ #:c⇩1)" by -(rule path_Main_SeqSecond,auto)
from ‹Rep_wf_prog wfp = (c⇩1;; c⇩2, procs)›
obtain wfp'' where [simp]:"Rep_wf_prog wfp'' = (c⇩1, procs)" by(erule wfp_Seq1)
from IH1[OF _ this,of "0"] obtain xs
where "wfp'' ⊢ (Main, Label 0) -xs→* (Main, Exit)"
and "∀a∈set xs. intra_kind (kind a)" by blast
from ‹wfp'' ⊢ (Main, Label 0) -xs→* (Main, Exit)› have "xs ≠ []"
by(fastforce elim:ProcCFG.path.cases)
then obtain x xs' where [simp]:"xs = xs'@[x]"
by(cases xs rule:rev_cases) fastforce+
with ‹wfp'' ⊢ (Main, Label 0) -xs→* (Main, Exit)›
have "wfp'' ⊢ (Main, Label 0) -xs'→* sourcenode x"
and "valid_edge wfp'' x" and "targetnode x = (Main, Exit)"
by(auto elim:ProcCFG.path_split_snoc)
from ‹valid_edge wfp'' x› ‹targetnode x = (Main, Exit)›
obtain nx where "sourcenode x = (Main,nx)"
by(fastforce elim:PCFG.cases simp:valid_edge_def)
with ‹wfp'' ⊢ (Main, Label 0) -xs'→* sourcenode x› have "nx ≠ Entry"
by fastforce
from ‹valid_edge wfp'' x› ‹sourcenode x = (Main,nx)› have "nx ≠ Exit"
by(fastforce intro:ProcCFGExit.Exit_source)
with ‹nx ≠ Entry› obtain lx where [simp]:"nx = Label lx" by(cases nx) auto
from ‹wfp'' ⊢ (Main, Label 0) -xs'→* sourcenode x›
‹sourcenode x = (Main,nx)› ‹∀a∈set xs. intra_kind (kind a)›
have "wfp ⊢ (Main, Entry)
-((Main, Entry),(λs. True)⇩√,(Main, Label 0))#xs'→* sourcenode x"
apply simp apply(rule path_SeqFirst[OF ‹Rep_wf_prog wfp'' = (c⇩1, procs)›])
apply(auto intro!:ProcCFG.Cons_path)
by(auto intro:Main Proc_CFG_Entry simp:valid_edge_def intra_kind_def)
with ‹valid_edge wfp'' x› ‹targetnode x = (Main, Exit)› path3
‹sourcenode x = (Main,nx)› ‹nx ≠ Entry› ‹sourcenode x = (Main,nx)› wf
have "wfp ⊢ (Main, Entry) -((((Main, Entry),(λs. True)⇩√,(Main, Label 0))#xs')@
[(sourcenode x,kind x,(Main,Label #:c⇩1))])@(asx' ⊕s #:c⇩1)→*
(Main, Label l' ⊕ #:c⇩1)"
by(fastforce intro:ProcCFG.path_Append ProcCFG.path.intros Main
Proc_CFG_SeqConnect elim!:PCFG.cases dest:Proc_CFG_Call_Labels
simp:ProcCFG.valid_node_def valid_edge_def)
ultimately show ?thesis using intra1 intra2 ‹∀a∈set xs. intra_kind (kind a)›
by(fastforce simp:label_incrs_def intra_kind_def)
qed
next
case (Cond b c⇩1 c⇩2)
note IH1 = ‹⋀l wfp. ⟦l < #:c⇩1; Rep_wf_prog wfp = (c⇩1, procs)⟧ ⟹
∃as as'. wfp ⊢ (Main, Label l) -as→* (Main, Exit) ∧
(∀a∈set as. intra_kind (kind a)) ∧
wfp ⊢ (Main, Entry) -as'→* (Main, Label l) ∧ (∀a∈set as'. intra_kind (kind a))›
note IH2 = ‹⋀l wfp. ⟦l < #:c⇩2; Rep_wf_prog wfp = (c⇩2, procs)⟧ ⟹
∃as as'. wfp ⊢ (Main, Label l) -as→* (Main, Exit) ∧
(∀a∈set as. intra_kind (kind a)) ∧
wfp ⊢ (Main, Entry) -as'→* (Main, Label l) ∧ (∀a∈set as'. intra_kind (kind a))›
note [simp] = ‹Rep_wf_prog wfp = (if (b) c⇩1 else c⇩2, procs)›
show ?case
proof(cases "l = 0")
case True
from ‹Rep_wf_prog wfp = (if (b) c⇩1 else c⇩2, procs)›
obtain wfp' where [simp]:"Rep_wf_prog wfp' = (c⇩1, procs)" by(erule wfp_CondTrue)
from IH1[OF _ this,of 0] obtain as
where path:"wfp' ⊢ (Main, Label 0) -as→* (Main, Exit)"
and intra:"∀a∈set as. intra_kind (kind a)" by blast
have "if (b) c⇩1 else c⇩2,procs ⊢ (Main,Label 0)
-(λcf. state_check cf b (Some true))⇩√→ (Main,Label 0 ⊕ 1)"
by(fastforce intro:Main Proc_CFG_CondTrue)
with path intra have "wfp ⊢ (Main,Label 0)
-[((Main,Label 0),(λcf. state_check cf b (Some true))⇩√,(Main,Label 0 ⊕ 1))]@
(as ⊕s 1)→* (Main,Exit ⊕ 1)"
apply - apply(rule ProcCFG.path_Append) apply(rule ProcCFG.path.intros)+
prefer 5 apply(rule path_Main_CondTrue)
apply(auto intro:ProcCFG.path.intros simp:valid_edge_def)
by(fastforce simp:ProcCFG.valid_node_def valid_edge_def)
moreover
have "if (b) c⇩1 else c⇩2,procs ⊢ (Main,Entry) -(λs. True)⇩√→
(Main,Label 0)" by(fastforce intro:Main Proc_CFG_Entry)
hence "wfp ⊢ (Main,Entry) -[((Main,Entry),(λs. True)⇩√,(Main,Label 0))]→*
(Main,Label 0)"
by(fastforce intro:ProcCFG.path.intros
simp:ProcCFG.valid_node_def valid_edge_def)
ultimately show ?thesis using ‹l = 0› ‹∀a∈set as. intra_kind (kind a)›
by(fastforce simp:label_incrs_def intra_kind_def)
next
case False
hence "0 < l" by simp
then obtain l' where [simp]:"l = l' + 1" and "l' = l - 1" by simp
show ?thesis
proof(cases "l' < #:c⇩1")
case True
from ‹Rep_wf_prog wfp = (if (b) c⇩1 else c⇩2, procs)›
obtain wfp' where [simp]:"Rep_wf_prog wfp' = (c⇩1, procs)"
by(erule wfp_CondTrue)
from IH1[OF True this] obtain as as'
where path1:"wfp' ⊢ (Main, Label l') -as→* (Main, Exit)"
and intra1:"∀a∈set as. intra_kind (kind a)"
and path2:"wfp' ⊢ (Main, Entry) -as'→* (Main, Label l')"
and intra2:"∀a∈set as'. intra_kind (kind a)" by blast
from path1 intra1
have "wfp ⊢ (Main, Label l' ⊕ 1) -as ⊕s 1→* (Main, Exit ⊕ 1)"
by -(rule path_Main_CondTrue,auto)
moreover
from path2 obtain ax' asx' where [simp]:"as' = ax'#asx'"
and "sourcenode ax' = (Main,Entry)" and "valid_edge wfp' ax'"
and "wfp' ⊢ targetnode ax' -asx'→* (Main, Label l')"
by -(erule ProcCFG.path.cases,fastforce+)
with wf have "targetnode ax' = (Main,Label 0)"
by(fastforce elim:PCFG.cases dest:Proc_CFG_EntryD Proc_CFG_Call_Labels
simp:valid_edge_def)
with ‹wfp' ⊢ targetnode ax' -asx'→* (Main, Label l')› intra2
have "wfp ⊢ (Main,Entry) -((Main,Entry),(λs. True)⇩√,(Main,Label 0))#
((Main,Label 0),(λcf. state_check cf b (Some true))⇩√,(Main,Label 0 ⊕ 1))#
(asx' ⊕s 1)→* (Main,Label l' ⊕ 1)"
apply - apply(rule ProcCFG.path.intros)+ apply(rule path_Main_CondTrue)
by(auto intro:Main Proc_CFG_Entry Proc_CFG_CondTrue simp:valid_edge_def)
ultimately show ?thesis using intra1 intra2
by(fastforce simp:label_incrs_def intra_kind_def)
next
case False
hence "#:c⇩1 ≤ l'" by simp
then obtain l'' where [simp]:"l' = l'' + #:c⇩1" and "l'' = l' - #:c⇩1" by simp
from ‹l < #:(if (b) c⇩1 else c⇩2)› have "l'' < #:c⇩2" by simp
from ‹Rep_wf_prog wfp = (if (b) c⇩1 else c⇩2, procs)›
obtain wfp'' where [simp]:"Rep_wf_prog wfp'' = (c⇩2, procs)"
by(erule wfp_CondFalse)
from IH2[OF ‹l'' < #:c⇩2› this] obtain as as'
where path1:"wfp'' ⊢ (Main, Label l'') -as→* (Main, Exit)"
and intra1:"∀a∈set as. intra_kind (kind a)"
and path2:"wfp'' ⊢ (Main, Entry) -as'→* (Main, Label l'')"
and intra2:"∀a∈set as'. intra_kind (kind a)" by blast
from path1 intra1
have "wfp ⊢ (Main, Label l'' ⊕ (#:c⇩1 + 1)) -as ⊕s (#:c⇩1 + 1)→*
(Main, Exit ⊕ (#:c⇩1 + 1))"
by -(rule path_Main_CondFalse,auto simp:add.assoc)
moreover
from path2 obtain ax' asx' where [simp]:"as' = ax'#asx'"
and "sourcenode ax' = (Main,Entry)" and "valid_edge wfp'' ax'"
and "wfp'' ⊢ targetnode ax' -asx'→* (Main, Label l'')"
by -(erule ProcCFG.path.cases,fastforce+)
with wf have "targetnode ax' = (Main,Label 0)"
by(fastforce elim:PCFG.cases dest:Proc_CFG_EntryD Proc_CFG_Call_Labels
simp:valid_edge_def)
with ‹wfp'' ⊢ targetnode ax' -asx'→* (Main, Label l'')› intra2
have "wfp ⊢ (Main,Entry) -((Main,Entry),(λs. True)⇩√,(Main,Label 0))#
((Main,Label 0),(λcf. state_check cf b (Some false))⇩√,
(Main,Label (#:c⇩1 + 1)))#(asx' ⊕s (#:c⇩1 + 1))→*
(Main,Label l'' ⊕ (#:c⇩1 + 1))"
apply - apply(rule ProcCFG.path.intros)+ apply(rule path_Main_CondFalse)
by(auto intro:Main Proc_CFG_Entry Proc_CFG_CondFalse simp:valid_edge_def)
ultimately show ?thesis using intra1 intra2
by(fastforce simp:label_incrs_def intra_kind_def add.assoc)
qed
qed
next
case (While b c')
note IH = ‹⋀l wfp. ⟦l < #:c'; Rep_wf_prog wfp = (c', procs)⟧ ⟹
∃as as'. wfp ⊢ (Main, Label l) -as→* (Main, Exit) ∧
(∀a∈set as. intra_kind (kind a)) ∧
wfp ⊢ (Main, Entry) -as'→* (Main, Label l) ∧ (∀a∈set as'. intra_kind (kind a))›
note [simp] = ‹Rep_wf_prog wfp = (while (b) c', procs)›
show ?case
proof(cases "l = 0")
case True
hence "wfp ⊢ (Main,Label l) -
((Main,Label 0),(λcf. state_check cf b (Some false))⇩√,(Main,Label 1))#
[((Main,Label 1),⇑id,(Main,Exit))]→* (Main,Exit)"
by(fastforce intro:ProcCFG.path.intros Main Proc_CFG_WhileFalseSkip
Proc_CFG_WhileFalse simp:valid_edge_def)
moreover
have "while (b) c' ⊢ Entry -IEdge (λs. True)⇩√→⇩p Label 0" by(rule Proc_CFG_Entry)
with ‹l = 0› have "wfp ⊢ (Main,Entry)
-[((Main,Entry),(λs. True)⇩√,(Main,Label 0))]→* (Main,Label l)"
by(fastforce intro:ProcCFG.path.intros Main
simp:ProcCFG.valid_node_def valid_edge_def)
ultimately show ?thesis by(fastforce simp:intra_kind_def)
next
case False
hence "1 ≤ l" by simp
thus ?thesis
proof(cases "l < 2")
case True
with ‹1 ≤ l› have [simp]:"l = 1" by simp
have "wfp ⊢ (Main,Label l) -[((Main,Label 1),⇑id,(Main,Exit))]→* (Main,Exit)"
by(fastforce intro:ProcCFG.path.intros Main Proc_CFG_WhileFalseSkip
simp:valid_edge_def)
moreover
have "while (b) c' ⊢ Label 0 -IEdge (λcf. state_check cf b (Some false))⇩√→⇩p
Label 1" by(rule Proc_CFG_WhileFalse)
hence "wfp ⊢ (Main,Entry) -((Main,Entry),(λs. True)⇩√,(Main,Label 0))#
[((Main,Label 0),(λcf. state_check cf b (Some false))⇩√,(Main,Label 1))]→*
(Main,Label l)"
by(fastforce intro:ProcCFG.path.intros Main Proc_CFG_Entry
simp:ProcCFG.valid_node_def valid_edge_def)
ultimately show ?thesis by(fastforce simp:intra_kind_def)
next
case False
with ‹1 ≤ l› have "2 ≤ l" by simp
then obtain l' where [simp]:"l = l' + 2" and "l' = l - 2"
by(simp del:add_2_eq_Suc')
from ‹l < #:while (b) c'› have "l' < #:c'" by simp
from ‹Rep_wf_prog wfp = (while (b) c', procs)›
obtain wfp' where [simp]:"Rep_wf_prog wfp' = (c', procs)"
by(erule wfp_WhileBody)
from IH[OF ‹l' < #:c'› this] obtain as as'
where path1:"wfp' ⊢ (Main, Label l') -as→* (Main, Exit)"
and intra1:"∀a∈set as. intra_kind (kind a)"
and path2:"wfp' ⊢ (Main, Entry) -as'→* (Main, Label l')"
and intra2:"∀a∈set as'. intra_kind (kind a)" by blast
from path1 have "as ≠ []" by(fastforce elim:ProcCFG.path.cases)
with path1 obtain ax asx where [simp]:"as = asx@[ax]"
and "wfp' ⊢ (Main, Label l') -asx→* sourcenode ax"
and "valid_edge wfp' ax" and "targetnode ax = (Main, Exit)"
by -(erule ProcCFG.path_split_snoc,fastforce+)
with wf obtain lx etx where "sourcenode ax = (Main,Label lx)"
and "intra_kind (kind ax)"
apply(auto elim!:PCFG.cases dest:Proc_CFG_Call_Labels simp:valid_edge_def)
by(case_tac n)(auto dest:Proc_CFG_IEdge_intra_kind)
with ‹wfp' ⊢ (Main, Label l') -asx→* sourcenode ax› intra1
have "wfp ⊢ (Main, Label l' ⊕ 2) -asx ⊕s 2→* (Main,Label lx ⊕ 2)"
by -(rule path_Main_WhileBody,auto)
from ‹valid_edge wfp' ax› ‹sourcenode ax = (Main,Label lx)›
‹targetnode ax = (Main, Exit)› ‹intra_kind (kind ax)› wf
have "while (b) c',procs ⊢ (Main,Label lx ⊕ 2) -kind ax→
(Main,Label 0)"
by(fastforce intro!:Main Proc_CFG_WhileBodyExit elim!:PCFG.cases
dest:Proc_CFG_Call_Labels simp:valid_edge_def)
hence "wfp ⊢ (Main,Label lx ⊕ 2)
-((Main,Label lx ⊕ 2),kind ax,(Main,Label 0))#
((Main,Label 0),(λcf. state_check cf b (Some false))⇩√,(Main,Label 1))#
[((Main,Label 1),⇑id,(Main,Exit))]→* (Main,Exit)"
by(fastforce intro:ProcCFG.path.intros Main Proc_CFG_WhileFalse
Proc_CFG_WhileFalseSkip simp:valid_edge_def)
with ‹wfp ⊢ (Main, Label l' ⊕ 2) -asx ⊕s 2→* (Main,Label lx ⊕ 2)›
have "wfp ⊢ (Main, Label l) -(asx ⊕s 2)@
(((Main,Label lx ⊕ 2),kind ax,(Main,Label 0))#
((Main,Label 0),(λcf. state_check cf b (Some false))⇩√,(Main,Label 1))#
[((Main,Label 1),⇑id,(Main,Exit))])→* (Main,Exit)"
by(fastforce intro:ProcCFG.path_Append)
moreover
from path2 have "as' ≠ []" by(fastforce elim:ProcCFG.path.cases)
with path2 obtain ax' asx' where [simp]:"as' = ax'#asx'"
and "wfp' ⊢ targetnode ax' -asx'→* (Main,Label l')"
and "valid_edge wfp' ax'" and "sourcenode ax' = (Main, Entry)"
by -(erule ProcCFG.path_split_Cons,fastforce+)
with wf have "targetnode ax' = (Main,Label 0)" and "intra_kind (kind ax')"
by(fastforce elim!:PCFG.cases dest:Proc_CFG_Call_Labels
Proc_CFG_EntryD simp:intra_kind_def valid_edge_def)+
with ‹wfp' ⊢ targetnode ax' -asx'→* (Main,Label l')› intra2
have "wfp ⊢ (Main, Label 0 ⊕ 2) -asx' ⊕s 2→* (Main,Label l' ⊕ 2)"
by -(rule path_Main_WhileBody,auto simp del:add_2_eq_Suc')
hence "wfp ⊢ (Main,Entry) -((Main,Entry),(λs. True)⇩√,(Main,Label 0))#
((Main,Label 0),(λcf. state_check cf b (Some true))⇩√,(Main,Label 2))#
(asx' ⊕s 2)→* (Main,Label l)"
by(fastforce intro:ProcCFG.path.intros Main Proc_CFG_WhileTrue
Proc_CFG_Entry simp:valid_edge_def)
ultimately show ?thesis using ‹intra_kind (kind ax)› intra1 intra2
by(fastforce simp:label_incrs_def intra_kind_def)
qed
qed
next
case (Call p es rets)
note Rep [simp] = ‹Rep_wf_prog wfp = (Call p es rets, procs)›
have cC:"containsCall procs (Call p es rets) [] p" by simp
show ?case
proof(cases "l = 0")
case True
have "wfp ⊢ (Main,Label 0) -((Main,Label 0),(λs. False)⇩√,(Main,Label 1))#
[((Main,Label 1),⇑id,(Main,Exit))]→* (Main,Exit)"
by(fastforce intro:ProcCFG.path.intros Main Proc_CFG_CallSkip MainCallReturn
Proc_CFG_Call simp:valid_edge_def)
moreover
have "Call p es rets,procs ⊢ (Main,Entry) -(λs. True)⇩√→ (Main,Label 0)"
by(fastforce intro:Main Proc_CFG_Entry)
hence "wfp ⊢ (Main,Entry) -[((Main,Entry),(λs. True)⇩√,(Main,Label 0))]→*
(Main,Label 0)"
by(fastforce intro:ProcCFG.path.intros
simp:ProcCFG.valid_node_def valid_edge_def)
ultimately show ?thesis using ‹l = 0› by(fastforce simp:intra_kind_def)
next
case False
with ‹l < #:Call p es rets› have "l = 1" by simp
have "wfp ⊢ (Main,Label 1) -[((Main,Label 1),⇑id,(Main,Exit))]→* (Main,Exit)"
by(fastforce intro:ProcCFG.path.intros Main Proc_CFG_CallSkip
simp:valid_edge_def)
moreover
have "Call p es rets,procs ⊢ (Main,Label 0) -(λs. False)⇩√→ (Main,Label 1)"
by(fastforce intro:MainCallReturn Proc_CFG_Call)
hence "wfp ⊢ (Main,Entry) -((Main,Entry),(λs. True)⇩√,(Main,Label 0))#
[((Main,Label 0),(λs. False)⇩√,(Main,Label 1))]→* (Main,Label 1)"
by(fastforce intro:ProcCFG.path.intros Main Proc_CFG_Entry
simp:ProcCFG.valid_node_def valid_edge_def)
ultimately show ?thesis using ‹l = 1› by(fastforce simp:intra_kind_def)
qed
qed
qed
subsection ‹Lifting from edges in procedure Main to arbitrary procedures›
lemma lift_edge_Main_Main:
"⟦c,procs ⊢ (Main, n) -et→ (Main, n'); (p,ins,outs,c) ∈ set procs;
containsCall procs prog ps p; well_formed procs⟧
⟹ prog,procs ⊢ (p, n) -et→ (p, n')"
proof(induct "(Main,n)" et "(Main,n')" rule:PCFG.induct)
case Main thus ?case by(fastforce intro:Proc)
next
case MainCallReturn thus ?case by(fastforce intro:ProcCallReturn)
qed auto
lemma lift_edge_Main_Proc:
"⟦c,procs ⊢ (Main, n) -et→ (q, n'); q ≠ Main; (p,ins,outs,c) ∈ set procs;
containsCall procs prog ps p; well_formed procs⟧
⟹ ∃et'. prog,procs ⊢ (p, n) -et'→ (q, n')"
proof(induct "(Main,n)" et "(q,n')" rule:PCFG.induct)
case (MainCall l esx retsx n'x insx outsx cx)
from ‹c ⊢ Label l -CEdge (q, esx, retsx)→⇩p n'x›
obtain l' where [simp]:"n'x = Label l'" by(fastforce dest:Proc_CFG_Call_Labels)
with MainCall have "prog,procs ⊢ (p, n)
-(λs. True):(p,n'x)↪⇘q⇙map (λe cf. interpret e cf) esx→ (q, n')"
by(fastforce intro:ProcCall)
thus ?case by fastforce
qed auto
lemma lift_edge_Proc_Main:
"⟦c,procs ⊢ (q, n) -et→ (Main, n'); q ≠ Main; (p,ins,outs,c) ∈ set procs;
containsCall procs prog ps p; well_formed procs⟧
⟹ ∃et'. prog,procs ⊢ (q, n) -et'→ (p, n')"
proof(induct "(q,n)" et "(Main,n')" rule:PCFG.induct)
case (MainReturn l esx retsx l' insx outsx cx)
note [simp] = ‹Exit = n›[THEN sym] ‹Label l' = n'›[THEN sym]
from MainReturn have "prog,procs ⊢ (q,Exit) -(λcf. snd cf = (p,Label l'))↩⇘q⇙
(λcf cf'. cf'(retsx [:=] map cf outsx))→ (p,Label l')"
by(fastforce intro!:ProcReturn)
thus ?case by fastforce
qed auto
fun lift_edge :: "edge ⇒ pname ⇒ edge"
where "lift_edge a p = ((p,snd(sourcenode a)),kind a,(p,snd(targetnode a)))"
fun lift_path :: "edge list ⇒ pname ⇒ edge list"
where "lift_path as p = map (λa. lift_edge a p) as"
lemma lift_path_Proc:
assumes "Rep_wf_prog wfp' = (c,procs)" and "Rep_wf_prog wfp = (prog,procs)"
and "(p,ins,outs,c) ∈ set procs" and "containsCall procs prog ps p"
shows "⟦wfp' ⊢ (Main,n) -as→* (Main,n'); ∀a ∈ set as. intra_kind (kind a)⟧
⟹ wfp ⊢ (p,n) -lift_path as p→* (p,n')"
proof(induct "(Main,n)" as "(Main,n')" arbitrary:n rule:ProcCFG.path.induct)
case empty_path
from ‹Rep_wf_prog wfp = (prog,procs)› have wf:"well_formed procs"
by(fastforce intro:wf_wf_prog)
from ‹CFG.valid_node sourcenode targetnode (valid_edge wfp') (Main, n')›
assms wf
have "CFG.valid_node sourcenode targetnode (valid_edge wfp) (p,n')"
apply(auto simp:ProcCFG.valid_node_def valid_edge_def)
apply(case_tac "ab = Main")
apply(fastforce dest:lift_edge_Main_Main)
apply(fastforce dest!:lift_edge_Main_Proc)
apply(case_tac "a = Main")
apply(fastforce dest:lift_edge_Main_Main)
by(fastforce dest!:lift_edge_Proc_Main)
thus ?case by(fastforce dest:ProcCFG.empty_path)
next
case (Cons_path m'' as a n)
note IH = ‹⋀n. ⟦m'' = (Main, n); ∀a∈set as. intra_kind (kind a)⟧
⟹ wfp ⊢ (p, n) -lift_path as p→* (p, n')›
from ‹Rep_wf_prog wfp = (prog,procs)› have wf:"well_formed procs"
by(fastforce intro:wf_wf_prog)
from ‹∀a∈set (a # as). intra_kind (kind a)› have "intra_kind (kind a)"
and "∀a∈set as. intra_kind (kind a)" by simp_all
from ‹valid_edge wfp' a› ‹intra_kind (kind a)› ‹sourcenode a = (Main, n)›
‹targetnode a = m''› ‹Rep_wf_prog wfp' = (c,procs)›
obtain n'' where "m'' = (Main, n'')"
by(fastforce elim:PCFG.cases simp:valid_edge_def intra_kind_def)
with ‹valid_edge wfp' a› ‹Rep_wf_prog wfp' = (c,procs)›
‹sourcenode a = (Main, n)› ‹targetnode a = m''›
‹(p,ins,outs,c) ∈ set procs› ‹containsCall procs prog ps p›
‹Rep_wf_prog wfp = (prog,procs)› wf
have "prog,procs ⊢ (p, n) -kind a→ (p, n'')"
by(auto intro:lift_edge_Main_Main simp:valid_edge_def)
from IH[OF ‹m'' = (Main, n'')› ‹∀a∈set as. intra_kind (kind a)›]
have "wfp ⊢ (p, n'') -lift_path as p→* (p, n')" .
with ‹prog,procs ⊢ (p, n) -kind a→ (p, n'')› ‹Rep_wf_prog wfp = (prog,procs)›
‹sourcenode a = (Main, n)› ‹targetnode a = m''› ‹m'' = (Main, n'')›
show ?case by simp (rule ProcCFG.Cons_path,auto simp:valid_edge_def)
qed
subsection ‹Existence of paths from Entry and to Exit›
lemma Label_Proc_CFG_Entry_Exit_path_Proc:
assumes "Rep_wf_prog wfp = (prog,procs)" and "l < #:c"
and "(p,ins,outs,c) ∈ set procs" and "containsCall procs prog ps p"
obtains as as' where "wfp ⊢ (p,Label l) -as→* (p,Exit)"
and "∀a ∈ set as. intra_kind (kind a)"
and "wfp ⊢ (p,Entry) -as'→* (p,Label l)"
and "∀a ∈ set as'. intra_kind (kind a)"
proof(atomize_elim)
from ‹Rep_wf_prog wfp = (prog,procs)› ‹(p,ins,outs,c) ∈ set procs›
‹containsCall procs prog ps p›
obtain wfp' where "Rep_wf_prog wfp' = (c,procs)" by(erule wfp_Call)
from this ‹l < #:c› obtain as as' where "wfp' ⊢ (Main,Label l) -as→* (Main,Exit)"
and "∀a ∈ set as. intra_kind (kind a)"
and "wfp' ⊢ (Main,Entry) -as'→* (Main,Label l)"
and "∀a ∈ set as'. intra_kind (kind a)"
by(erule Label_Proc_CFG_Entry_Exit_path_Main)
from ‹Rep_wf_prog wfp' = (c,procs)› ‹Rep_wf_prog wfp = (prog,procs)›
‹(p,ins,outs,c) ∈ set procs› ‹containsCall procs prog ps p›
‹wfp' ⊢ (Main,Label l) -as→* (Main,Exit)› ‹∀a ∈ set as. intra_kind (kind a)›
have "wfp ⊢ (p,Label l) -lift_path as p→* (p,Exit)"
by(fastforce intro:lift_path_Proc)
moreover
from ‹Rep_wf_prog wfp' = (c,procs)› ‹Rep_wf_prog wfp = (prog,procs)›
‹(p,ins,outs,c) ∈ set procs› ‹containsCall procs prog ps p›
‹wfp' ⊢ (Main,Entry) -as'→* (Main,Label l)› ‹∀a ∈ set as'. intra_kind (kind a)›
have "wfp ⊢ (p,Entry) -lift_path as' p→* (p,Label l)"
by(fastforce intro:lift_path_Proc)
moreover
from ‹∀a ∈ set as. intra_kind (kind a)› ‹∀a ∈ set as'. intra_kind (kind a)›
have "∀a ∈ set (lift_path as p). intra_kind (kind a)"
and "∀a ∈ set (lift_path as' p). intra_kind (kind a)" by auto
ultimately
show "∃as as'. wfp ⊢ (p, Label l) -as→* (p, Exit) ∧
(∀a∈set as. intra_kind (kind a)) ∧ wfp ⊢ (p, Entry) -as'→* (p, Label l) ∧
(∀a∈set as'. intra_kind (kind a))" by fastforce
qed
lemma Entry_to_Entry_and_Exit_to_Exit:
assumes "Rep_wf_prog wfp = (prog,procs)"
and "containsCall procs prog ps p" and "(p,ins,outs,c) ∈ set procs"
obtains as as' where "CFG.valid_path' sourcenode targetnode kind
(valid_edge wfp) (get_return_edges wfp) (Main,Entry) as (p,Entry)"
and "CFG.valid_path' sourcenode targetnode kind
(valid_edge wfp) (get_return_edges wfp) (p,Exit) as' (Main,Exit)"
proof(atomize_elim)
from ‹containsCall procs prog ps p› ‹(p,ins,outs,c) ∈ set procs›
show "∃as as'. CFG.valid_path' sourcenode targetnode kind (valid_edge wfp)
(get_return_edges wfp) (Main, Entry) as (p, Entry) ∧
CFG.valid_path' sourcenode targetnode kind (valid_edge wfp)
(get_return_edges wfp) (p, Exit) as' (Main, Exit)"
proof(induct ps arbitrary:p ins outs c rule:rev_induct)
case Nil
from ‹containsCall procs prog [] p›
obtain lx es rets lx' where "prog ⊢ Label lx -CEdge (p,es,rets)→⇩p Label lx'"
by(erule containsCall_empty_Proc_CFG_Call_edge)
with ‹(p, ins, outs, c) ∈ set procs›
have "prog,procs ⊢ (Main,Label lx) -(λs. True):(Main,Label lx')↪⇘p⇙
map (λe cf. interpret e cf) es→ (p,Entry)"
and "prog,procs ⊢ (p,Exit) -(λcf. snd cf = (Main,Label lx'))↩⇘p⇙
(λcf cf'. cf'(rets [:=] map cf outs))→ (Main,Label lx')"
by -(rule MainCall,assumption+,rule MainReturn)
with ‹Rep_wf_prog wfp = (prog,procs)›
have "wfp ⊢ (Main,Label lx) -[((Main,Label lx),
(λs. True):(Main,Label lx')↪⇘p⇙map (λe cf. interpret e cf) es,(p,Entry))]→*
(p,Entry)"
and "wfp ⊢ (p,Exit) -[((p,Exit),(λcf. snd cf = (Main,Label lx'))↩⇘p⇙
(λcf cf'. cf'(rets [:=] map cf outs)),(Main,Label lx'))]→* (Main,Label lx')"
by(fastforce intro:ProcCFG.path.intros
simp:ProcCFG.valid_node_def valid_edge_def)+
moreover
from ‹prog ⊢ Label lx -CEdge (p,es,rets)→⇩p Label lx'›
have "lx < #:prog" and "lx' < #:prog"
by(auto intro:Proc_CFG_sourcelabel_less_num_nodes
Proc_CFG_targetlabel_less_num_nodes)
from ‹Rep_wf_prog wfp = (prog,procs)› ‹lx < #:prog› obtain as
where "wfp ⊢ (Main,Entry) -as→* (Main,Label lx)"
and "∀a ∈ set as. intra_kind (kind a)"
by -(erule Label_Proc_CFG_Entry_Exit_path_Main)
moreover
from ‹Rep_wf_prog wfp = (prog,procs)› ‹lx' < #:prog› obtain as'
where "wfp ⊢ (Main,Label lx') -as'→* (Main,Exit)"
and "∀a ∈ set as'. intra_kind (kind a)"
by -(erule Label_Proc_CFG_Entry_Exit_path_Main)
moreover
from ‹∀a ∈ set as. intra_kind (kind a)›
have "CFG.valid_path kind (get_return_edges wfp)
(as@[((Main,Label lx),(λs. True):(Main,Label lx')↪⇘p⇙
map (λe cf. interpret e cf) es,(p,Entry))])"
by(fastforce intro:ProcCFG.same_level_path_valid_path_Append
ProcCFG.intras_same_level_path simp:ProcCFG.valid_path_def)
moreover
from ‹∀a ∈ set as'. intra_kind (kind a)›
have "CFG.valid_path kind (get_return_edges wfp)
([((p,Exit),(λcf. snd cf = (Main,Label lx'))↩⇘p⇙
(λcf cf'. cf'(rets [:=] map cf outs)),(Main,Label lx'))]@as')"
by(fastforce intro:ProcCFG.valid_path_same_level_path_Append
ProcCFG.intras_same_level_path simp:ProcCFG.valid_path_def)
ultimately show ?case by(fastforce intro:ProcCFG.path_Append simp:ProcCFG.vp_def)
next
case (snoc p' ps')
note IH = ‹⋀p ins outs c.
⟦containsCall procs prog ps' p; (p,ins,outs,c) ∈ set procs⟧
⟹ ∃as as'. CFG.valid_path' sourcenode targetnode kind (valid_edge wfp)
(get_return_edges wfp) (Main, Entry) as (p, Entry) ∧
CFG.valid_path' sourcenode targetnode kind (valid_edge wfp)
(get_return_edges wfp) (p, Exit) as' (Main, Exit)›
from ‹containsCall procs prog (ps' @ [p']) p›
obtain ins' outs' c' where "(p',ins',outs',c') ∈ set procs"
and "containsCall procs c' [] p"
and "containsCall procs prog ps' p'" by(auto elim:containsCallE)
from IH[OF ‹containsCall procs prog ps' p'› ‹(p',ins',outs',c') ∈ set procs›]
obtain as as' where pathE:"CFG.valid_path' sourcenode targetnode kind
(valid_edge wfp) (get_return_edges wfp) (Main, Entry) as (p', Entry)"
and pathX:"CFG.valid_path' sourcenode targetnode kind (valid_edge wfp)
(get_return_edges wfp) (p', Exit) as' (Main, Exit)" by blast
from ‹containsCall procs c' [] p›
obtain lx es rets lx' where edge:"c' ⊢ Label lx -CEdge (p,es,rets)→⇩p Label lx'"
by(erule containsCall_empty_Proc_CFG_Call_edge)
hence "lx < #:c'" and "lx' < #:c'"
by(auto intro:Proc_CFG_sourcelabel_less_num_nodes
Proc_CFG_targetlabel_less_num_nodes)
from ‹lx < #:c'› ‹Rep_wf_prog wfp = (prog,procs)› ‹(p',ins',outs',c') ∈ set procs›
‹containsCall procs prog ps' p'› obtain asx
where "wfp ⊢ (p',Entry) -asx→* (p',Label lx)"
and "∀a ∈ set asx. intra_kind (kind a)"
by(fastforce elim:Label_Proc_CFG_Entry_Exit_path_Proc)
with pathE have pathE2:"CFG.valid_path' sourcenode targetnode kind
(valid_edge wfp) (get_return_edges wfp) (Main, Entry) (as@asx) (p', Label lx)"
by(fastforce intro:ProcCFG.path_Append ProcCFG.valid_path_same_level_path_Append
ProcCFG.intras_same_level_path simp:ProcCFG.vp_def)
from ‹lx' < #:c'› ‹Rep_wf_prog wfp = (prog,procs)›
‹(p',ins',outs',c') ∈ set procs› ‹containsCall procs prog ps' p'›
obtain asx' where "wfp ⊢ (p',Label lx') -asx'→* (p',Exit)"
and "∀a ∈ set asx'. intra_kind (kind a)"
by(fastforce elim:Label_Proc_CFG_Entry_Exit_path_Proc)
with pathX have pathX2:"CFG.valid_path' sourcenode targetnode kind
(valid_edge wfp) (get_return_edges wfp) (p', Label lx') (asx'@as') (Main, Exit)"
by(fastforce intro:ProcCFG.path_Append ProcCFG.same_level_path_valid_path_Append
ProcCFG.intras_same_level_path simp:ProcCFG.vp_def)
from edge ‹(p,ins,outs,c) ∈ set procs› ‹(p',ins',outs',c') ∈ set procs›
‹containsCall procs prog ps' p'›
have "prog,procs ⊢ (p',Label lx) -(λs. True):(p',Label lx')↪⇘p⇙
map (λe cf. interpret e cf) es→ (p,Entry)"
and "prog,procs ⊢ (p,Exit) -(λcf. snd cf = (p',Label lx'))↩⇘p⇙
(λcf cf'. cf'(rets [:=] map cf outs))→ (p',Label lx')"
by(fastforce intro:ProcCall ProcReturn)+
with ‹Rep_wf_prog wfp = (prog,procs)›
have path:"wfp ⊢ (p',Label lx) -[((p',Label lx),(λs. True):(p',Label lx')↪⇘p⇙
map (λe cf. interpret e cf) es,(p,Entry))]→* (p,Entry)"
and path':"wfp ⊢ (p,Exit) -[((p,Exit),(λcf. snd cf = (p',Label lx'))↩⇘p⇙
(λcf cf'. cf'(rets [:=] map cf outs)),(p',Label lx'))]→*
(p',Label lx')"
by(fastforce intro:ProcCFG.path.intros
simp:ProcCFG.valid_node_def valid_edge_def)+
from path pathE2 have "CFG.valid_path' sourcenode targetnode kind (valid_edge wfp)
(get_return_edges wfp) (Main, Entry) ((as@asx)@[((p',Label lx),
(λs. True):(p',Label lx')↪⇘p⇙map (λe cf. interpret e cf) es,(p,Entry))])
(p,Entry)"
apply(unfold ProcCFG.vp_def) apply(rule conjI)
apply(fastforce intro:ProcCFG.path_Append)
by(unfold ProcCFG.valid_path_def,fastforce intro:ProcCFG.vpa_snoc_Call)
moreover
from path' pathX2 have "CFG.valid_path' sourcenode targetnode kind
(valid_edge wfp) (get_return_edges wfp) (p,Exit)
([((p,Exit),(λcf. snd cf = (p',Label lx'))↩⇘p⇙
(λcf cf'. cf'(rets [:=] map cf outs)),(p',Label lx'))]@(asx'@as')) (Main, Exit)"
apply(unfold ProcCFG.vp_def) apply(rule conjI)
apply(fastforce intro:ProcCFG.path_Append)
by(simp add:ProcCFG.valid_path_def ProcCFG.valid_path_def)
ultimately show ?case by blast
qed
qed
lemma edge_valid_paths:
assumes "prog,procs ⊢ sourcenode a -kind a→ targetnode a"
and disj:"(p,n) = sourcenode a ∨ (p,n) = targetnode a"
and [simp]:"Rep_wf_prog wfp = (prog,procs)"
shows "∃as as'. CFG.valid_path' sourcenode targetnode kind (valid_edge wfp)
(get_return_edges wfp) (Main,Entry) as (p,n) ∧
CFG.valid_path' sourcenode targetnode kind (valid_edge wfp)
(get_return_edges wfp) (p,n) as' (Main,Exit)"
proof -
from ‹Rep_wf_prog wfp = (prog,procs)› have wf:"well_formed procs"
by(fastforce intro:wf_wf_prog)
from ‹prog,procs ⊢ sourcenode a -kind a→ targetnode a›
show ?thesis
proof(induct "sourcenode a" "kind a" "targetnode a" rule:PCFG.induct)
case (Main nx nx')
from ‹(Main, nx) = sourcenode a›[THEN sym] ‹(Main, nx') = targetnode a›[THEN sym]
disj have [simp]:"p = Main" by auto
have "prog,procs ⊢ (Main, Entry) -(λs. False)⇩√→ (Main, Exit)"
by(fastforce intro:PCFG.Main Proc_CFG_Entry_Exit)
hence EXpath:"wfp ⊢ (Main,Entry) -[((Main,Entry),(λs. False)⇩√,(Main,Exit))]→*
(Main,Exit)"
by(fastforce intro:ProcCFG.path.intros
simp:valid_edge_def ProcCFG.valid_node_def)
show ?case
proof(cases n)
case (Label l)
with ‹prog ⊢ nx -IEdge (kind a)→⇩p nx'› ‹(Main, nx) = sourcenode a›[THEN sym]
‹(Main, nx') = targetnode a›[THEN sym] disj
have "l < #:prog" by(auto intro:Proc_CFG_sourcelabel_less_num_nodes
Proc_CFG_targetlabel_less_num_nodes)
with ‹Rep_wf_prog wfp = (prog,procs)›
obtain as as' where "wfp ⊢ (Main,Entry) -as→* (Main,Label l)"
and "∀a ∈ set as. intra_kind (kind a)"
and "wfp ⊢ (Main,Label l) -as'→* (Main,Exit)"
and "∀a ∈ set as'. intra_kind (kind a)"
by -(erule Label_Proc_CFG_Entry_Exit_path_Main)+
with Label show ?thesis
apply(rule_tac x="as" in exI) apply(rule_tac x="as'" in exI) apply simp
by(fastforce intro:ProcCFG.intra_path_vp simp:ProcCFG.intra_path_def)
next
case Entry
hence "wfp ⊢ (Main,Entry) -[]→* (Main,n)" by(fastforce intro:ProcCFG.empty_path)
with EXpath show ?thesis by(fastforce simp:ProcCFG.vp_def ProcCFG.valid_path_def)
next
case Exit
hence "wfp ⊢ (Main,n) -[]→* (Main,Exit)" by(fastforce intro:ProcCFG.empty_path)
with Exit EXpath show ?thesis using Exit
apply(rule_tac x="[((Main,Entry),(λs. False)⇩√,(Main,Exit))]" in exI)
apply simp
by(fastforce intro:ProcCFG.intra_path_vp
simp:ProcCFG.intra_path_def intra_kind_def)
qed
next
case (Proc px ins outs c nx nx' ps)
from ‹(px, ins, outs, c) ∈ set procs› wf have [simp]:"px ≠ Main" by auto
from disj ‹(px, nx) = sourcenode a›[THEN sym] ‹(px, nx') = targetnode a›[THEN sym]
have [simp]:"p = px" by auto
from ‹Rep_wf_prog wfp = (prog,procs)›
‹containsCall procs prog ps px› ‹(px, ins, outs, c) ∈ set procs›
obtain asx asx' where path:"CFG.valid_path' sourcenode targetnode kind
(valid_edge wfp) (get_return_edges wfp) (Main,Entry) asx (px,Entry)"
and path':"CFG.valid_path' sourcenode targetnode kind
(valid_edge wfp) (get_return_edges wfp) (px,Exit) asx' (Main,Exit)"
by -(erule Entry_to_Entry_and_Exit_to_Exit)+
from ‹containsCall procs prog ps px› ‹(px, ins, outs, c) ∈ set procs›
have "prog,procs ⊢ (px, Entry) -(λs. False)⇩√→ (px, Exit)"
by(fastforce intro:PCFG.Proc Proc_CFG_Entry_Exit)
hence EXpath:"wfp ⊢ (px,Entry) -[((px,Entry),(λs. False)⇩√,(px,Exit))]→*
(px,Exit)" by(fastforce intro:ProcCFG.path.intros
simp:valid_edge_def ProcCFG.valid_node_def)
show ?case
proof(cases n)
case (Label l)
with ‹c ⊢ nx -IEdge (kind a)→⇩p nx'› disj ‹(px, nx) = sourcenode a›[THEN sym]
‹(px, nx') = targetnode a›[THEN sym]
have "l < #:c" by(auto intro:Proc_CFG_sourcelabel_less_num_nodes
Proc_CFG_targetlabel_less_num_nodes)
with ‹Rep_wf_prog wfp = (prog,procs)› ‹(px, ins, outs, c) ∈ set procs›
‹containsCall procs prog ps px›
obtain as as' where "wfp ⊢ (px,Entry) -as→* (px,Label l)"
and "∀a ∈ set as. intra_kind (kind a)"
and "wfp ⊢ (px,Label l) -as'→* (px,Exit)"
and "∀a ∈ set as'. intra_kind (kind a)"
by -(erule Label_Proc_CFG_Entry_Exit_path_Proc)+
with path path' show ?thesis using Label
apply(rule_tac x="asx@as" in exI) apply(rule_tac x="as'@asx'" in exI)
by(auto intro:ProcCFG.path_Append ProcCFG.valid_path_same_level_path_Append
ProcCFG.same_level_path_valid_path_Append ProcCFG.intras_same_level_path
simp:ProcCFG.vp_def)
next
case Entry
from EXpath path' have "CFG.valid_path' sourcenode targetnode kind
(valid_edge wfp) (get_return_edges wfp) (px,Entry)
([((px,Entry),(λs. False)⇩√,(px,Exit))]@asx') (Main, Exit)"
apply(unfold ProcCFG.vp_def) apply(erule conjE) apply(rule conjI)
by(fastforce intro:ProcCFG.path_Append
ProcCFG.same_level_path_valid_path_Append ProcCFG.intras_same_level_path
simp:intra_kind_def)+
with path Entry show ?thesis by simp blast
next
case Exit
with path EXpath path' show ?thesis
apply(rule_tac x="asx@[((px,Entry),(λs. False)⇩√,(px,Exit))]" in exI)
apply simp
by(fastforce intro:ProcCFG.path_Append
ProcCFG.valid_path_same_level_path_Append ProcCFG.intras_same_level_path
simp:ProcCFG.vp_def ProcCFG.intra_path_def intra_kind_def)
qed
next
case (MainCall l px es rets nx' ins outs c)
from disj show ?case
proof
assume "(p,n) = sourcenode a"
with ‹(Main, Label l) = sourcenode a›[THEN sym]
have [simp]:"n = Label l" "p = Main" by simp_all
with ‹prog ⊢ Label l -CEdge (px, es, rets)→⇩p nx'› have "l < #:prog"
by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
with ‹Rep_wf_prog wfp = (prog,procs)›
obtain as as' where "wfp ⊢ (Main,Entry) -as→* (Main,Label l)"
and "∀a ∈ set as. intra_kind (kind a)"
and "wfp ⊢ (Main,Label l) -as'→* (Main,Exit)"
and "∀a ∈ set as'. intra_kind (kind a)"
by -(erule Label_Proc_CFG_Entry_Exit_path_Main)+
thus ?thesis
by(fastforce intro:ProcCFG.intra_path_vp simp:ProcCFG.intra_path_def)
next
assume "(p,n) = targetnode a"
with ‹(px, Entry) = targetnode a›[THEN sym]
have [simp]:"n = Entry" "p = px" by simp_all
from ‹prog ⊢ Label l -CEdge (px, es, rets)→⇩p nx'›
have "containsCall procs prog [] px"
by(rule Proc_CFG_Call_containsCall)
with ‹Rep_wf_prog wfp = (prog,procs)› ‹(px, ins, outs, c) ∈ set procs›
obtain as' where Xpath:"CFG.valid_path' sourcenode targetnode kind
(valid_edge wfp) (get_return_edges wfp) (px,Exit) as' (Main,Exit)"
by -(erule Entry_to_Entry_and_Exit_to_Exit)
from ‹containsCall procs prog [] px› ‹(px, ins, outs, c) ∈ set procs›
have "prog,procs ⊢ (px, Entry) -(λs. False)⇩√→ (px, Exit)"
by(fastforce intro:PCFG.Proc Proc_CFG_Entry_Exit)
hence "wfp ⊢ (px,Entry) -[((px,Entry),(λs. False)⇩√,(px,Exit))]→* (px,Exit)"
by(fastforce intro:ProcCFG.path.intros
simp:valid_edge_def ProcCFG.valid_node_def)
with Xpath have "CFG.valid_path' sourcenode targetnode kind
(valid_edge wfp) (get_return_edges wfp) (px,Entry)
([((px,Entry),(λs. False)⇩√,(px,Exit))]@as') (Main,Exit)"
apply(unfold ProcCFG.vp_def) apply(erule conjE) apply(rule conjI)
by(fastforce intro:ProcCFG.path_Append
ProcCFG.same_level_path_valid_path_Append ProcCFG.intras_same_level_path
simp:intra_kind_def)+
with ‹containsCall procs prog [] px› ‹Rep_wf_prog wfp = (prog,procs)›
‹(px, ins, outs, c) ∈ set procs›
show ?thesis by(fastforce elim:Entry_to_Entry_and_Exit_to_Exit)
qed
next
case (ProcCall px ins outs c l p' es' rets' l' ins' outs' c' ps)
from disj show ?case
proof
assume "(p,n) = sourcenode a"
with ‹(px, Label l) = sourcenode a›[THEN sym]
have [simp]:"n = Label l" "p = px" by simp_all
with ‹c ⊢ Label l -CEdge (p', es', rets')→⇩p Label l'› have "l < #:c"
by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
from ‹Rep_wf_prog wfp = (prog,procs)› ‹l < #:c›
‹containsCall procs prog ps px› ‹(px, ins, outs, c) ∈ set procs›
obtain as as' where "wfp ⊢ (px,Label l) -as→* (px,Exit)"
and "∀a ∈ set as. intra_kind (kind a)"
and "wfp ⊢ (px,Entry) -as'→* (px,Label l)"
and "∀a ∈ set as'. intra_kind (kind a)"
by -(erule Label_Proc_CFG_Entry_Exit_path_Proc)+
moreover
from ‹Rep_wf_prog wfp = (prog,procs)› ‹containsCall procs prog ps px›
‹(px, ins, outs, c) ∈ set procs› obtain asx asx'
where" CFG.valid_path' sourcenode targetnode kind
(valid_edge wfp) (get_return_edges wfp) (Main,Entry) asx (px,Entry)"
and "CFG.valid_path' sourcenode targetnode kind
(valid_edge wfp) (get_return_edges wfp) (px,Exit) asx' (Main,Exit)"
by -(erule Entry_to_Entry_and_Exit_to_Exit)+
ultimately show ?thesis
apply(rule_tac x="asx@as'" in exI) apply(rule_tac x="as@asx'" in exI)
by(auto intro:ProcCFG.path_Append ProcCFG.valid_path_same_level_path_Append
ProcCFG.same_level_path_valid_path_Append ProcCFG.intras_same_level_path
simp:ProcCFG.vp_def)
next
assume "(p,n) = targetnode a"
with ‹(p', Entry) = targetnode a›[THEN sym]
have [simp]:"n = Entry" "p = p'" by simp_all
from ‹c ⊢ Label l -CEdge (p', es', rets')→⇩p Label l'›
have "containsCall procs c [] p'" by(rule Proc_CFG_Call_containsCall)
with ‹containsCall procs prog ps px› ‹(px, ins, outs, c) ∈ set procs›
have "containsCall procs prog (ps@[px]) p'"
by(rule containsCall_in_proc)
with ‹(p', ins', outs', c') ∈ set procs›
have "prog,procs ⊢ (p', Entry) -(λs. False)⇩√→ (p', Exit)"
by(fastforce intro:PCFG.Proc Proc_CFG_Entry_Exit)
hence "wfp ⊢ (p',Entry) -[((p',Entry),(λs. False)⇩√,(p',Exit))]→* (p',Exit)"
by(fastforce intro:ProcCFG.path.intros
simp:valid_edge_def ProcCFG.valid_node_def)
moreover
from ‹Rep_wf_prog wfp = (prog,procs)› ‹(p', ins', outs', c') ∈ set procs›
‹containsCall procs prog (ps@[px]) p'›
obtain as as' where "CFG.valid_path' sourcenode targetnode kind
(valid_edge wfp) (get_return_edges wfp) (Main,Entry) as (p',Entry)"
and "CFG.valid_path' sourcenode targetnode kind
(valid_edge wfp) (get_return_edges wfp) (p',Exit) as' (Main,Exit)"
by -(erule Entry_to_Entry_and_Exit_to_Exit)+
ultimately show ?thesis
apply(rule_tac x="as" in exI)
apply(rule_tac x="[((p',Entry),(λs. False)⇩√,(p',Exit))]@as'" in exI)
apply(unfold ProcCFG.vp_def)
by(fastforce intro:ProcCFG.path_Append
ProcCFG.same_level_path_valid_path_Append ProcCFG.intras_same_level_path
simp:intra_kind_def)+
qed
next
case (MainReturn l px es rets l' ins outs c)
from disj show ?case
proof
assume "(p,n) = sourcenode a"
with ‹(px, Exit) = sourcenode a›[THEN sym]
have [simp]:"n = Exit" "p = px" by simp_all
from ‹prog ⊢ Label l -CEdge (px, es, rets)→⇩p Label l'›
have "containsCall procs prog [] px" by(rule Proc_CFG_Call_containsCall)
with ‹(px, ins, outs, c) ∈ set procs›
have "prog,procs ⊢ (px, Entry) -(λs. False)⇩√→ (px, Exit)"
by(fastforce intro:PCFG.Proc Proc_CFG_Entry_Exit)
hence "wfp ⊢ (px,Entry) -[((px,Entry),(λs. False)⇩√,(px,Exit))]→* (px,Exit)"
by(fastforce intro:ProcCFG.path.intros
simp:valid_edge_def ProcCFG.valid_node_def)
moreover
from ‹Rep_wf_prog wfp = (prog,procs)› ‹(px, ins, outs, c) ∈ set procs›
‹containsCall procs prog [] px›
obtain as as' where "CFG.valid_path' sourcenode targetnode kind
(valid_edge wfp) (get_return_edges wfp) (Main,Entry) as (px,Entry)"
and "CFG.valid_path' sourcenode targetnode kind
(valid_edge wfp) (get_return_edges wfp) (px,Exit) as' (Main,Exit)"
by -(erule Entry_to_Entry_and_Exit_to_Exit)+
ultimately show ?thesis
apply(rule_tac x="as@[((px,Entry),(λs. False)⇩√,(px,Exit))]" in exI)
apply(rule_tac x="as'" in exI)
apply(unfold ProcCFG.vp_def)
by(fastforce intro:ProcCFG.path_Append
ProcCFG.valid_path_same_level_path_Append ProcCFG.intras_same_level_path
simp:intra_kind_def)+
next
assume "(p, n) = targetnode a"
with ‹(Main, Label l') = targetnode a›[THEN sym]
have [simp]:"n = Label l'" "p = Main" by simp_all
with ‹prog ⊢ Label l -CEdge (px, es, rets)→⇩p Label l'› have "l' < #:prog"
by(fastforce intro:Proc_CFG_targetlabel_less_num_nodes)
with ‹Rep_wf_prog wfp = (prog,procs)›
obtain as as' where "wfp ⊢ (Main,Entry) -as→* (Main,Label l')"
and "∀a ∈ set as. intra_kind (kind a)"
and "wfp ⊢ (Main,Label l') -as'→* (Main,Exit)"
and "∀a ∈ set as'. intra_kind (kind a)"
by -(erule Label_Proc_CFG_Entry_Exit_path_Main)+
thus ?thesis
by(fastforce intro:ProcCFG.intra_path_vp simp:ProcCFG.intra_path_def)
qed
next
case (ProcReturn px ins outs c l p' es' rets' l' ins' outs' c' ps)
from disj show ?case
proof
assume "(p,n) = sourcenode a"
with ‹(p', Exit) = sourcenode a›[THEN sym]
have [simp]:"n = Exit" "p = p'" by simp_all
from ‹c ⊢ Label l -CEdge (p', es', rets')→⇩p Label l'›
have "containsCall procs c [] p'" by(rule Proc_CFG_Call_containsCall)
with ‹containsCall procs prog ps px› ‹(px, ins, outs, c) ∈ set procs›
have "containsCall procs prog (ps@[px]) p'"
by(rule containsCall_in_proc)
with ‹(p', ins', outs', c') ∈ set procs›
have "prog,procs ⊢ (p', Entry) -(λs. False)⇩√→ (p', Exit)"
by(fastforce intro:PCFG.Proc Proc_CFG_Entry_Exit)
hence "wfp ⊢ (p',Entry) -[((p',Entry),(λs. False)⇩√,(p',Exit))]→* (p',Exit)"
by(fastforce intro:ProcCFG.path.intros
simp:valid_edge_def ProcCFG.valid_node_def)
moreover
from ‹Rep_wf_prog wfp = (prog,procs)› ‹(p', ins', outs', c') ∈ set procs›
‹containsCall procs prog (ps@[px]) p'›
obtain as as' where "CFG.valid_path' sourcenode targetnode kind
(valid_edge wfp) (get_return_edges wfp) (Main,Entry) as (p',Entry)"
and "CFG.valid_path' sourcenode targetnode kind
(valid_edge wfp) (get_return_edges wfp) (p',Exit) as' (Main,Exit)"
by -(erule Entry_to_Entry_and_Exit_to_Exit)+
ultimately show ?thesis
apply(rule_tac x="as@[((p',Entry),(λs. False)⇩√,(p',Exit))]" in exI)
apply(rule_tac x="as'" in exI)
apply(unfold ProcCFG.vp_def)
by(fastforce intro:ProcCFG.path_Append
ProcCFG.valid_path_same_level_path_Append ProcCFG.intras_same_level_path
simp:intra_kind_def)+
next
assume "(p, n) = targetnode a"
with ‹(px, Label l') = targetnode a›[THEN sym]
have [simp]:"n = Label l'" "p = px" by simp_all
with ‹c ⊢ Label l -CEdge (p', es', rets')→⇩p Label l'› have "l' < #:c"
by(fastforce intro:Proc_CFG_targetlabel_less_num_nodes)
from ‹Rep_wf_prog wfp = (prog,procs)› ‹l' < #:c›
‹containsCall procs prog ps px› ‹(px, ins, outs, c) ∈ set procs›
obtain as as' where "wfp ⊢ (px,Label l') -as→* (px,Exit)"
and "∀a ∈ set as. intra_kind (kind a)"
and "wfp ⊢ (px,Entry) -as'→* (px,Label l')"
and "∀a ∈ set as'. intra_kind (kind a)"
by -(erule Label_Proc_CFG_Entry_Exit_path_Proc)+
moreover
from ‹Rep_wf_prog wfp = (prog,procs)› ‹containsCall procs prog ps px›
‹(px, ins, outs, c) ∈ set procs› obtain asx asx'
where" CFG.valid_path' sourcenode targetnode kind
(valid_edge wfp) (get_return_edges wfp) (Main,Entry) asx (px,Entry)"
and "CFG.valid_path' sourcenode targetnode kind
(valid_edge wfp) (get_return_edges wfp) (px,Exit) asx' (Main,Exit)"
by -(erule Entry_to_Entry_and_Exit_to_Exit)+
ultimately show ?thesis
apply(rule_tac x="asx@as'" in exI) apply(rule_tac x="as@asx'" in exI)
by(auto intro:ProcCFG.path_Append ProcCFG.valid_path_same_level_path_Append
ProcCFG.same_level_path_valid_path_Append ProcCFG.intras_same_level_path
simp:ProcCFG.vp_def)
qed
next
case (MainCallReturn nx px es rets nx')
from ‹prog ⊢ nx -CEdge (px, es, rets)→⇩p nx'› disj
‹(Main, nx) = sourcenode a›[THEN sym] ‹(Main, nx') = targetnode a›[THEN sym]
obtain l where [simp]:"n = Label l" "p = Main"
by(fastforce dest:Proc_CFG_Call_Labels)
from ‹prog ⊢ nx -CEdge (px, es, rets)→⇩p nx'› disj
‹(Main, nx) = sourcenode a›[THEN sym] ‹(Main, nx') = targetnode a›[THEN sym]
have "l < #:prog" by(auto intro:Proc_CFG_sourcelabel_less_num_nodes
Proc_CFG_targetlabel_less_num_nodes)
with ‹Rep_wf_prog wfp = (prog,procs)›
obtain as as' where "wfp ⊢ (Main,Entry) -as→* (Main,Label l)"
and "∀a ∈ set as. intra_kind (kind a)"
and "wfp ⊢ (Main,Label l) -as'→* (Main,Exit)"
and "∀a ∈ set as'. intra_kind (kind a)"
by -(erule Label_Proc_CFG_Entry_Exit_path_Main)+
thus ?thesis
apply(rule_tac x="as" in exI) apply(rule_tac x="as'" in exI) apply simp
by(fastforce intro:ProcCFG.intra_path_vp simp:ProcCFG.intra_path_def)
next
case (ProcCallReturn px ins outs c nx p' es' rets' nx' ps)
from ‹(px, ins, outs, c) ∈ set procs› wf have [simp]:"px ≠ Main" by auto
from ‹c ⊢ nx -CEdge (p', es', rets')→⇩p nx'› disj
‹(px, nx) = sourcenode a›[THEN sym] ‹(px, nx') = targetnode a›[THEN sym]
obtain l where [simp]:"n = Label l" "p = px"
by(fastforce dest:Proc_CFG_Call_Labels)
from ‹c ⊢ nx -CEdge (p', es', rets')→⇩p nx'› disj
‹(px, nx) = sourcenode a›[THEN sym] ‹(px, nx') = targetnode a›[THEN sym]
have "l < #:c"
by(auto intro:Proc_CFG_sourcelabel_less_num_nodes
Proc_CFG_targetlabel_less_num_nodes)
with ‹Rep_wf_prog wfp = (prog,procs)› ‹(px, ins, outs, c) ∈ set procs›
‹containsCall procs prog ps px›
obtain as as' where "wfp ⊢ (px,Entry) -as→* (px,Label l)"
and "∀a ∈ set as. intra_kind (kind a)"
and "wfp ⊢ (px,Label l) -as'→* (px,Exit)"
and "∀a ∈ set as'. intra_kind (kind a)"
by -(erule Label_Proc_CFG_Entry_Exit_path_Proc)+
moreover
from ‹Rep_wf_prog wfp = (prog,procs)›
‹containsCall procs prog ps px› ‹(px, ins, outs, c) ∈ set procs›
obtain asx asx' where "CFG.valid_path' sourcenode targetnode kind
(valid_edge wfp) (get_return_edges wfp) (Main,Entry) asx (px,Entry)"
and "CFG.valid_path' sourcenode targetnode kind
(valid_edge wfp) (get_return_edges wfp) (px,Exit) asx' (Main,Exit)"
by -(erule Entry_to_Entry_and_Exit_to_Exit)+
ultimately show ?thesis
apply(rule_tac x="asx@as" in exI) apply(rule_tac x="as'@asx'" in exI)
by(auto intro:ProcCFG.path_Append ProcCFG.valid_path_same_level_path_Append
ProcCFG.same_level_path_valid_path_Append ProcCFG.intras_same_level_path
simp:ProcCFG.vp_def)
qed
qed
subsection ‹Instantiating the ‹Postdomination› locale›
interpretation ProcPostdomination:
Postdomination sourcenode targetnode kind "valid_edge wfp" "(Main,Entry)"
get_proc "get_return_edges wfp" "lift_procs wfp" Main "(Main,Exit)"
for wfp
proof -
from Rep_wf_prog[of wfp]
obtain prog procs where [simp]:"Rep_wf_prog wfp = (prog,procs)"
by(fastforce simp:wf_prog_def)
hence wf:"well_formed procs" by(fastforce intro:wf_wf_prog)
show "Postdomination sourcenode targetnode kind (valid_edge wfp)
(Main, Entry) get_proc (get_return_edges wfp) (lift_procs wfp) Main (Main, Exit)"
proof
fix m
assume "CFG.valid_node sourcenode targetnode (valid_edge wfp) m"
then obtain a where "valid_edge wfp a"
and "m = sourcenode a ∨ m = targetnode a"
by(fastforce simp:ProcCFG.valid_node_def)
obtain p n where [simp]:"m = (p,n)" by(cases m) auto
from ‹valid_edge wfp a› ‹m = sourcenode a ∨ m = targetnode a›
‹Rep_wf_prog wfp = (prog,procs)›
show "∃as. CFG.valid_path' sourcenode targetnode kind (valid_edge wfp)
(get_return_edges wfp) (Main, Entry) as m"
by(auto dest!:edge_valid_paths simp:valid_edge_def)
next
fix m
assume "CFG.valid_node sourcenode targetnode (valid_edge wfp) m"
then obtain a where "valid_edge wfp a"
and "m = sourcenode a ∨ m = targetnode a"
by(fastforce simp:ProcCFG.valid_node_def)
obtain p n where [simp]:"m = (p,n)" by(cases m) auto
from ‹valid_edge wfp a› ‹m = sourcenode a ∨ m = targetnode a›
‹Rep_wf_prog wfp = (prog,procs)›
show "∃as. CFG.valid_path' sourcenode targetnode kind (valid_edge wfp)
(get_return_edges wfp) m as (Main,Exit)"
by(auto dest!:edge_valid_paths simp:valid_edge_def)
next
fix n n'
assume mex1:"CFGExit.method_exit sourcenode kind (valid_edge wfp) (Main,Exit) n"
and mex2:"CFGExit.method_exit sourcenode kind (valid_edge wfp) (Main,Exit) n'"
and "get_proc n = get_proc n'"
from mex1
have "n = (Main,Exit) ∨ (∃a Q p f. n = sourcenode a ∧ valid_edge wfp a ∧
kind a = Q↩⇘p⇙f)" by(simp add:ProcCFGExit.method_exit_def)
thus "n = n'"
proof
assume "n = (Main,Exit)"
from mex2 have "n' = (Main,Exit) ∨ (∃a Q p f. n' = sourcenode a ∧
valid_edge wfp a ∧ kind a = Q↩⇘p⇙f)"
by(simp add:ProcCFGExit.method_exit_def)
thus ?thesis
proof
assume "n' = (Main,Exit)"
with ‹n = (Main,Exit)› show ?thesis by simp
next
assume "∃a Q p f. n' = sourcenode a ∧
valid_edge wfp a ∧ kind a = Q↩⇘p⇙f"
then obtain a Q p f where "n' = sourcenode a"
and "valid_edge wfp a" and "kind a = Q↩⇘p⇙f" by blast
from ‹valid_edge wfp a› ‹kind a = Q↩⇘p⇙f›
have "get_proc (sourcenode a) = p" by(rule ProcCFG.get_proc_return)
with ‹get_proc n = get_proc n'› ‹n = (Main,Exit)› ‹n' = sourcenode a›
have "get_proc (Main,Exit) = p" by simp
hence "p = Main" by simp
with ‹kind a = Q↩⇘p⇙f› have "kind a = Q↩⇘Main⇙f" by simp
with ‹valid_edge wfp a› have False by(rule ProcCFG.Main_no_return_source)
thus ?thesis by simp
qed
next
assume "∃a Q p f. n = sourcenode a ∧
valid_edge wfp a ∧ kind a = Q↩⇘p⇙f"
then obtain a Q p f where "n = sourcenode a"
and "valid_edge wfp a" and "kind a = Q↩⇘p⇙f" by blast
from ‹valid_edge wfp a› ‹kind a = Q↩⇘p⇙f›
have "get_proc (sourcenode a) = p" by(rule ProcCFG.get_proc_return)
from mex2 have "n' = (Main,Exit) ∨ (∃a Q p f. n' = sourcenode a ∧
valid_edge wfp a ∧ kind a = Q↩⇘p⇙f)"
by(simp add:ProcCFGExit.method_exit_def)
thus ?thesis
proof
assume "n' = (Main,Exit)"
from ‹get_proc (sourcenode a) = p› ‹get_proc n = get_proc n'›
‹n' = (Main,Exit)› ‹n = sourcenode a›
have "get_proc (Main,Exit) = p" by simp
hence "p = Main" by simp
with ‹kind a = Q↩⇘p⇙f› have "kind a = Q↩⇘Main⇙f" by simp
with ‹valid_edge wfp a› have False by(rule ProcCFG.Main_no_return_source)
thus ?thesis by simp
next
assume "∃a Q p f. n' = sourcenode a ∧
valid_edge wfp a ∧ kind a = Q↩⇘p⇙f"
then obtain a' Q' p' f' where "n' = sourcenode a'"
and "valid_edge wfp a'" and "kind a' = Q'↩⇘p'⇙f'" by blast
from ‹valid_edge wfp a'› ‹kind a' = Q'↩⇘p'⇙f'›
have "get_proc (sourcenode a') = p'" by(rule ProcCFG.get_proc_return)
with ‹get_proc n = get_proc n'› ‹get_proc (sourcenode a) = p›
‹n = sourcenode a› ‹n' = sourcenode a'›
have "p' = p" by simp
from ‹valid_edge wfp a› ‹kind a = Q↩⇘p⇙f›
have "sourcenode a = (p,Exit)" by(auto elim:PCFG.cases simp:valid_edge_def)
from ‹valid_edge wfp a'› ‹kind a' = Q'↩⇘p'⇙f'›
have "sourcenode a' = (p',Exit)" by(auto elim:PCFG.cases simp:valid_edge_def)
with ‹n = sourcenode a› ‹n' = sourcenode a'› ‹p' = p›
‹sourcenode a = (p,Exit)› show ?thesis by simp
qed
qed
qed
qed
end
Theory ProcSDG
section ‹Instantiation of the SDG locale›
theory ProcSDG imports ValidPaths "../StaticInter/SDG" begin
interpretation Proc_SDG:
SDG sourcenode targetnode kind "valid_edge wfp" "(Main,Entry)"
get_proc "get_return_edges wfp" "lift_procs wfp" Main "(Main,Exit)"
"Def wfp" "Use wfp" "ParamDefs wfp" "ParamUses wfp"
for wfp ..
end
Theory JVMCFG
chapter ‹A Control Flow Graph for Jinja Byte Code›
section ‹Formalizing the CFG›
theory JVMCFG imports "../StaticInter/BasicDefs" Jinja.BVExample begin
declare lesub_list_impl_same_size [simp del]
declare listE_length [simp del]
subsection ‹Type definitions›
subsubsection ‹Wellformed Programs›
definition "wf_jvmprog = {(P, Phi). wf_jvm_prog⇘Phi⇙ P}"
typedef wf_jvmprog = "wf_jvmprog"
proof
show "(E, Phi) ∈ wf_jvmprog"
unfolding wf_jvmprog_def by (auto intro: wf_prog)
qed
hide_const Phi E
abbreviation PROG :: "wf_jvmprog ⇒ jvm_prog"
where "PROG P ≡ fst(Rep_wf_jvmprog(P))"
abbreviation TYPING :: "wf_jvmprog ⇒ ty⇩P"
where "TYPING P ≡ snd(Rep_wf_jvmprog(P))"
lemma wf_jvmprog_is_wf_typ: "wf_jvm_prog⇘TYPING P⇙ (PROG P)"
using Rep_wf_jvmprog [of P]
by (auto simp: wf_jvmprog_def split_beta)
lemma wf_jvmprog_is_wf: "wf_jvm_prog (PROG P)"
using wf_jvmprog_is_wf_typ unfolding wf_jvm_prog_def
by blast
subsubsection ‹Interprocedural CFG›
type_synonym jvm_method = "wf_jvmprog × cname × mname"
datatype var = Heap | Local "nat" | Stack "nat" | Exception
datatype val = Hp "heap" | Value "Value.val"
type_synonym state = "var ⇀ val"
definition valid_state :: "state ⇒ bool"
where "valid_state s ≡ (∀val. s Heap ≠ Some (Value val))
∧ (s Exception = None ∨ (∃addr. s Exception = Some (Value (Addr addr))))
∧ (∀var. var ≠ Heap ∧ var ≠ Exception ⟶ (∀h. s var ≠ Some (Hp h)))"
fun the_Heap :: "val ⇒ heap"
where "the_Heap (Hp h) = h"
fun the_Value :: "val ⇒ Value.val"
where "the_Value (Value v) = v"
abbreviation heap_of :: "state ⇒ heap"
where "heap_of s ≡ the_Heap (the (s Heap))"
abbreviation exc_flag :: "state ⇒ addr option"
where "exc_flag s ≡ case (s Exception) of None ⇒ None
| Some v ⇒ Some (THE a. v = Value (Addr a))"
abbreviation stkAt :: "state ⇒ nat ⇒ Value.val"
where "stkAt s n ≡ the_Value (the (s (Stack n)))"
abbreviation locAt :: "state ⇒ nat ⇒ Value.val"
where "locAt s n ≡ the_Value (the (s (Local n)))"
datatype nodeType = Enter | Normal | Return | Exceptional "pc option" "nodeType"
type_synonym cfg_node = "cname × mname × pc option × nodeType"
type_synonym
cfg_edge = "cfg_node × (var, val, cname × mname × pc, cname × mname) edge_kind × cfg_node"
definition ClassMain :: "wf_jvmprog ⇒ cname"
where "ClassMain P ≡ SOME Name. ¬ is_class (PROG P) Name"
definition MethodMain :: "wf_jvmprog ⇒ mname"
where "MethodMain P ≡ SOME Name.
∀C D fs ms. class (PROG P) C = ⌊(D, fs, ms)⌋ ⟶ (∀m ∈ set ms. Name ≠ fst m)"
definition stkLength :: "jvm_method ⇒ pc ⇒ nat"
where
"stkLength m pc ≡ let (P, C, M) = m in (
if (C = ClassMain P) then 1 else (
length (fst(the(((TYPING P) C M) ! pc)))
))"
definition locLength :: "jvm_method ⇒ pc ⇒ nat"
where
"locLength m pc ≡ let (P, C, M) = m in (
if (C = ClassMain P) then 1 else (
length (snd(the(((TYPING P) C M) ! pc)))
))"
lemma ex_new_class_name: "∃C. ¬ is_class P C"
proof -
have "¬ finite (UNIV :: cname set)"
by (rule infinite_UNIV_listI)
hence "∃C. C ∉ set (map fst P)"
by -(rule ex_new_if_finite, auto)
then obtain C where "C ∉ set (map fst P)"
by blast
have "¬ is_class P C"
proof
assume "is_class P C"
then obtain D fs ms where "class P C = ⌊(D, fs, ms)⌋"
by auto
with ‹C ∉ set (map fst P)› show False
by (auto dest: map_of_SomeD intro!: image_eqI simp: class_def)
qed
thus ?thesis
by blast
qed
lemma ClassMain_unique_in_P:
assumes "is_class (PROG P) C"
shows "ClassMain P ≠ C"
proof -
from ex_new_class_name [of "PROG P"] obtain D where "¬ is_class (PROG P) D"
by blast
with ‹is_class (PROG P) C› show ?thesis
unfolding ClassMain_def
by -(rule someI2, fastforce+)
qed
lemma map_of_fstD: "⟦ map_of xs a = ⌊b⌋; ∀x ∈ set xs. fst x ≠ a ⟧ ⟹ False"
by (induct xs, auto)
lemma map_of_fstE: "⟦ map_of xs a = ⌊b⌋; ∃x ∈ set xs. fst x = a ⟹ thesis ⟧ ⟹ thesis"
by (induct xs) (auto split: if_split_asm)
lemma ex_unique_method_name:
"∃Name. ∀C D fs ms. class (PROG P) C = ⌊(D, fs, ms)⌋ ⟶ (∀m∈set ms. Name ≠ fst m)"
proof -
from wf_jvmprog_is_wf [of P]
have "distinct_fst (PROG P)"
by (simp add: wf_jvm_prog_def wf_jvm_prog_phi_def wf_prog_def)
hence "{C. ∃D fs ms. class (PROG P) C = ⌊(D, fs, ms)⌋} = fst ` set (PROG P)"
by (fastforce elim: map_of_fstE simp: class_def intro: map_of_SomeI)
hence "finite {C. ∃D fs ms. class (PROG P) C = ⌊(D, fs, ms)⌋}"
by auto
moreover have "{ms. ∃C D fs. class (PROG P) C = ⌊(D, fs, ms)⌋}
= snd ` snd ` the ` (λC. class (PROG P) C) ` {C. ∃D fs ms. class (PROG P) C = ⌊(D, fs, ms)⌋}"
by (fastforce intro: rev_image_eqI map_of_SomeI simp: class_def)
ultimately have "finite {ms. ∃C D fs. class (PROG P) C = ⌊(D, fs, ms)⌋}"
by auto
moreover have "¬ finite (UNIV :: mname set)"
by (rule infinite_UNIV_listI)
ultimately
have "∃Name. Name ∉ fst ` (⋃ms ∈ {ms. ∃C D fs. class (PROG P) C = ⌊(D, fs, ms)⌋}. set ms)"
by -(rule ex_new_if_finite, auto)
thus ?thesis
by fastforce
qed
lemma MethodMain_unique_in_P:
assumes "PROG P ⊢ D sees M:Ts→T = mb in C"
shows "MethodMain P ≠ M"
proof -
from ex_unique_method_name [of P] obtain M'
where "⋀C D fs ms. class (PROG P) C = ⌊(D, fs, ms)⌋ ⟹ (∀m ∈ set ms. M' ≠ fst m)"
by blast
with ‹PROG P ⊢ D sees M:Ts→T = mb in C›
show ?thesis
unfolding MethodMain_def
by -(rule someI2_ex, fastforce, fastforce dest!: visible_method_exists elim: map_of_fstE)
qed
lemma ClassMain_is_no_class [dest!]: "is_class (PROG P) (ClassMain P) ⟹ False"
proof (erule rev_notE)
from ex_new_class_name [of "PROG P"] obtain C where "¬ is_class (PROG P) C"
by blast
thus "¬ is_class (PROG P) (ClassMain P)" unfolding ClassMain_def
by (rule someI)
qed
lemma MethodMain_not_seen [dest!]: "PROG P ⊢ C sees (MethodMain P):Ts→T = mb in D ⟹ False"
by (fastforce dest: MethodMain_unique_in_P)
lemma no_Call_from_ClassMain [dest!]: "PROG P ⊢ ClassMain P sees M:Ts→T = mb in C ⟹ False"
by (fastforce dest: sees_method_is_class)
lemma no_Call_in_ClassMain [dest!]: "PROG P ⊢ C sees M:Ts→T = mb in ClassMain P ⟹ False"
by (fastforce dest: sees_method_idemp)
inductive JVMCFG :: "jvm_method ⇒ cfg_node ⇒ (var, val, cname × mname × pc, cname × mname) edge_kind ⇒ cfg_node ⇒ bool" (" _ ⊢ _ -_→ _")
and reachable :: "jvm_method ⇒ cfg_node ⇒ bool" (" _ ⊢ ⇒_")
where
Entry_reachable: "(P, C0, Main) ⊢ ⇒(ClassMain P, MethodMain P, None, Enter)"
| reachable_step: "⟦ P ⊢ ⇒n; P ⊢ n -(e)→ n' ⟧ ⟹ P ⊢ ⇒n'"
| Main_to_Call: "(P, C0, Main) ⊢ ⇒(ClassMain P, MethodMain P, ⌊0⌋, Enter)
⟹ (P, C0, Main) ⊢ (ClassMain P, MethodMain P, ⌊0⌋, Enter) -⇑id→ (ClassMain P, MethodMain P, ⌊0⌋, Normal)"
| Main_Call_LFalse: "(P, C0, Main) ⊢ ⇒(ClassMain P, MethodMain P, ⌊0⌋, Normal)
⟹ (P, C0, Main) ⊢ (ClassMain P, MethodMain P, ⌊0⌋, Normal) -(λs. False)⇩√→ (ClassMain P, MethodMain P, ⌊0⌋, Return)"
| Main_Call: "⟦ (P, C0, Main) ⊢ ⇒(ClassMain P, MethodMain P, ⌊0⌋, Normal);
PROG P ⊢ C0 sees Main:[]→T = (mxs, mxl⇩0, is, xt) in D;
initParams = [(λs. s Heap),(λs. ⌊Value Null⌋)];
ek = (λ(s, ret). True):(ClassMain P, MethodMain P, 0)↪⇘(D, Main)⇙initParams ⟧
⟹ (P, C0, Main) ⊢ (ClassMain P, MethodMain P, ⌊0⌋, Normal) -(ek)→ (D, Main, None, Enter)"
| Main_Return_to_Exit: "(P, C0, Main) ⊢ ⇒(ClassMain P, MethodMain P, ⌊0⌋, Return)
⟹ (P, C0, Main) ⊢ (ClassMain P, MethodMain P, ⌊0⌋, Return) -(⇑id)→ (ClassMain P, MethodMain P, None, Return)"
| Method_LFalse: "(P, C0, Main) ⊢ ⇒(C, M, None, Enter)
⟹ (P, C0, Main) ⊢ (C, M, None, Enter) -(λs. False)⇩√→ (C, M, None, Return)"
| Method_LTrue: "(P, C0, Main) ⊢ ⇒(C, M, None, Enter)
⟹ (P, C0, Main) ⊢ (C, M, None, Enter) -(λs. True)⇩√→ (C, M, ⌊0⌋, Enter)"
| CFG_Load: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter); instrs_of (PROG P) C M ! pc = Load n;
ek = ⇑(λs. s(Stack (stkLength (P, C, M) pc) := s (Local n))) ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Enter) -(ek)→ (C, M, ⌊Suc pc⌋, Enter)"
| CFG_Store: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter); instrs_of (PROG P) C M ! pc = Store n;
ek = ⇑(λs. s(Local n := s (Stack (stkLength (P, C, M) pc - 1)))) ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Enter) -(ek)→ (C, M, ⌊Suc pc⌋, Enter)"
| CFG_Push: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter); instrs_of (PROG P) C M ! pc = Push v;
ek = ⇑(λs. s(Stack (stkLength (P, C, M) pc) ↦ Value v)) ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Enter) -(ek)→ (C, M, ⌊Suc pc⌋, Enter)"
| CFG_Pop: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter); instrs_of (PROG P) C M ! pc = Pop;
ek = ⇑id ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Enter) -(ek)→ (C, M, ⌊Suc pc⌋, Enter)"
| CFG_IAdd: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter); instrs_of (PROG P) C M ! pc = IAdd;
ek = ⇑(λs. let i1 = the_Intg (stkAt s (stkLength (P, C, M) pc - 1));
i2 = the_Intg (stkAt s (stkLength (P, C, M) pc - 2))
in s(Stack (stkLength (P, C, M) pc - 2) ↦ Value (Intg (i1 + i2)))) ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Enter) -(ek)→ (C, M, ⌊Suc pc⌋, Enter)"
| CFG_Goto: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter); instrs_of (PROG P) C M ! pc = Goto i ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Enter) -((λs. True)⇩√)→ (C, M, ⌊nat (int pc + i)⌋, Enter)"
| CFG_CmpEq: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter); instrs_of (PROG P) C M ! pc = CmpEq;
ek = ⇑(λs. let e1 = stkAt s (stkLength (P, C, M) pc - 1);
e2 = stkAt s (stkLength (P, C, M) pc - 2)
in s(Stack (stkLength (P, C, M) pc - 2) ↦ Value (Bool (e1 = e2)))) ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Enter) -(ek)→ (C, M, ⌊Suc pc⌋, Enter)"
| CFG_IfFalse_False: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter);
instrs_of (PROG P) C M ! pc = IfFalse i;
i ≠ 1;
ek = (λs. stkAt s (stkLength(P, C, M) pc - 1) = Bool False)⇩√ ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Enter) -(ek)→ (C, M, ⌊nat (int pc + i)⌋, Enter)"
| CFG_IfFalse_True: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter);
instrs_of (PROG P) C M ! pc = IfFalse i;
ek = (λs. stkAt s (stkLength(P, C, M) pc - 1) ≠ Bool False ∨ i = 1)⇩√ ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Enter) -(ek)→ (C, M, ⌊Suc pc⌋, Enter)"
| CFG_New_Check_Normal: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter);
instrs_of (PROG P) C M ! pc = New Cl;
ek = (λs. new_Addr (heap_of s) ≠ None)⇩√ ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Enter) -(ek)→ (C, M, ⌊pc⌋, Normal)"
| CFG_New_Check_Exceptional: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter);
instrs_of (PROG P) C M ! pc = New Cl;
pc' = (case (match_ex_table (PROG P) OutOfMemory pc (ex_table_of (PROG P) C M)) of
None ⇒ None
| Some (pc'', d) ⇒ ⌊pc''⌋);
ek = (λs. new_Addr (heap_of s) = None)⇩√ ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Enter) -(ek)→ (C, M, ⌊pc⌋, Exceptional pc' Enter)"
| CFG_New_Update: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Normal);
instrs_of (PROG P) C M ! pc = New Cl;
ek = ⇑(λs. let a = the (new_Addr (heap_of s))
in s(Heap ↦ Hp ((heap_of s)(a ↦ blank (PROG P) Cl)))
(Stack (stkLength(P, C, M) pc) ↦ Value (Addr a))) ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Normal) -(ek)→ (C, M, ⌊Suc pc⌋, Enter)"
| CFG_New_Exceptional_prop: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional None Enter);
instrs_of (PROG P) C M ! pc = New Cl;
ek = ⇑(λs. s(Exception ↦ Value (Addr (addr_of_sys_xcpt OutOfMemory)))) ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Exceptional None Enter) -(ek)→ (C, M, None, Return)"
| CFG_New_Exceptional_handle: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter);
instrs_of (PROG P) C M ! pc = New Cl;
ek = ⇑(λs. s(Exception := None)
(Stack (stkLength (P, C, M) pc' - 1) ↦ Value (Addr (addr_of_sys_xcpt OutOfMemory)))) ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter) -(ek)→ (C, M, ⌊pc'⌋, Enter)"
| CFG_Getfield_Check_Normal: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter);
instrs_of (PROG P) C M ! pc = Getfield F Cl;
ek = (λs. stkAt s (stkLength (P, C, M) pc - 1) ≠ Null)⇩√ ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Enter) -(ek)→ (C, M, ⌊pc⌋, Normal)"
| CFG_Getfield_Check_Exceptional: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter);
instrs_of (PROG P) C M ! pc = Getfield F Cl;
pc' = (case (match_ex_table (PROG P) NullPointer pc (ex_table_of (PROG P) C M)) of
None ⇒ None
| Some (pc'', d) ⇒ ⌊pc''⌋);
ek = (λs. stkAt s (stkLength (P, C, M) pc - 1) = Null)⇩√ ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Enter) -(ek)→ (C, M, ⌊pc⌋, Exceptional pc' Enter)"
| CFG_Getfield_Update: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Normal);
instrs_of (PROG P) C M ! pc = Getfield F Cl;
ek = ⇑(λs. let (D, fs) = the (heap_of s (the_Addr (stkAt s (stkLength (P, C, M) pc - 1))))
in s(Stack (stkLength(P, C, M) pc - 1) ↦ Value (the (fs (F, Cl))))) ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Normal) -(ek)→ (C, M, ⌊Suc pc⌋, Enter)"
| CFG_Getfield_Exceptional_prop: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional None Enter);
instrs_of (PROG P) C M ! pc = Getfield F Cl;
ek = ⇑(λs. s(Exception ↦ Value (Addr (addr_of_sys_xcpt NullPointer)))) ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Exceptional None Enter) -(ek)→ (C, M, None, Return)"
| CFG_Getfield_Exceptional_handle: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter);
instrs_of (PROG P) C M ! pc = Getfield F Cl;
ek = ⇑(λs. s(Exception := None)
(Stack (stkLength (P, C, M) pc' - 1) ↦ Value (Addr (addr_of_sys_xcpt NullPointer)))) ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter) -(ek)→ (C, M, ⌊pc'⌋, Enter)"
| CFG_Putfield_Check_Normal: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter);
instrs_of (PROG P) C M ! pc = Putfield F Cl;
ek = (λs. stkAt s (stkLength (P, C, M) pc - 2) ≠ Null)⇩√ ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Enter) -(ek)→ (C, M, ⌊pc⌋, Normal)"
| CFG_Putfield_Check_Exceptional: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter);
instrs_of (PROG P) C M ! pc = Putfield F Cl;
pc' = (case (match_ex_table (PROG P) NullPointer pc (ex_table_of (PROG P) C M)) of
None ⇒ None
| Some (pc'', d) ⇒ ⌊pc''⌋);
ek = (λs. stkAt s (stkLength (P, C, M) pc - 2) = Null)⇩√ ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Enter) -(ek)→ (C, M, ⌊pc⌋, Exceptional pc' Enter)"
| CFG_Putfield_Update: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Normal);
instrs_of (PROG P) C M ! pc = Putfield F Cl;
ek = ⇑(λs. let v = stkAt s (stkLength (P, C, M) pc - 1);
r = stkAt s (stkLength (P, C, M) pc - 2);
a = the_Addr r;
(D, fs) = the (heap_of s a);
h' = (heap_of s)(a ↦ (D, fs((F, Cl) ↦ v)))
in s(Heap ↦ Hp h')) ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Normal) -(ek)→ (C, M, ⌊Suc pc⌋, Enter)"
| CFG_Putfield_Exceptional_prop: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional None Enter);
instrs_of (PROG P) C M ! pc = Putfield F Cl;
ek = ⇑(λs. s(Exception ↦ Value (Addr (addr_of_sys_xcpt NullPointer)))) ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Exceptional None Enter) -(ek)→ (C, M, None, Return)"
| CFG_Putfield_Exceptional_handle: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter);
instrs_of (PROG P) C M ! pc = Putfield F Cl;
ek = ⇑(λs. s(Exception := None)
(Stack (stkLength (P, C, M) pc' - 1) ↦ Value (Addr (addr_of_sys_xcpt NullPointer)))) ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter) -(ek)→ (C, M, ⌊pc'⌋, Enter)"
| CFG_Checkcast_Check_Normal: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter);
instrs_of (PROG P) C M ! pc = Checkcast Cl;
ek = (λs. cast_ok (PROG P) Cl (heap_of s) (stkAt s (stkLength (P, C, M) pc - 1)))⇩√ ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Enter) -(ek)→ (C, M, ⌊Suc pc⌋, Enter)"
| CFG_Checkcast_Check_Exceptional: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter);
instrs_of (PROG P) C M ! pc = Checkcast Cl;
pc' = (case (match_ex_table (PROG P) ClassCast pc (ex_table_of (PROG P) C M)) of
None ⇒ None
| Some (pc'', d) ⇒ ⌊pc''⌋);
ek = (λs. ¬ cast_ok (PROG P) Cl (heap_of s) (stkAt s (stkLength (P, C, M) pc - 1)))⇩√ ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Enter) -(ek)→ (C, M, ⌊pc⌋, Exceptional pc' Enter)"
| CFG_Checkcast_Exceptional_prop: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional None Enter);
instrs_of (PROG P) C M ! pc = Checkcast Cl;
ek = ⇑(λs. s(Exception ↦ Value (Addr (addr_of_sys_xcpt ClassCast)))) ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Exceptional None Enter) -(ek)→ (C, M, None, Return)"
| CFG_Checkcast_Exceptional_handle: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter);
instrs_of (PROG P) C M ! pc = Checkcast Cl;
ek = ⇑(λs. s(Exception := None)
(Stack (stkLength (P, C, M) pc' - 1) ↦ Value (Addr (addr_of_sys_xcpt ClassCast)))) ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter) -(ek)→ (C, M, ⌊pc'⌋, Enter)"
| CFG_Throw_Check: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter);
instrs_of (PROG P) C M ! pc = Throw;
pc' = None ∨ match_ex_table (PROG P) Exc pc (ex_table_of (PROG P) C M) = ⌊(the pc', d)⌋;
ek = (λs. let v = stkAt s (stkLength (P, C, M) pc - 1);
Cl = if (v = Null) then NullPointer else (cname_of (heap_of s) (the_Addr v))
in case pc' of
None ⇒ match_ex_table (PROG P) Cl pc (ex_table_of (PROG P) C M) = None
| Some pc'' ⇒ ∃d. match_ex_table (PROG P) Cl pc (ex_table_of (PROG P) C M)
= ⌊(pc'', d)⌋
)⇩√ ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Enter) -(ek)→ (C, M, ⌊pc⌋, Exceptional pc' Enter)"
| CFG_Throw_prop: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional None Enter);
instrs_of (PROG P) C M ! pc = Throw;
ek = ⇑(λs. s(Exception ↦ Value (stkAt s (stkLength (P, C, M) pc - 1)))) ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Exceptional None Enter) -(ek)→ (C, M, None, Return)"
| CFG_Throw_handle: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter);
pc' ≠ length (instrs_of (PROG P) C M);
instrs_of (PROG P) C M ! pc = Throw;
ek = ⇑(λs. s(Exception := None)
(Stack (stkLength (P, C, M) pc' - 1) ↦ Value (stkAt s (stkLength (P, C, M) pc - 1)))) ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter) -(ek)→ (C, M, ⌊pc'⌋, Enter)"
| CFG_Invoke_Check_NP_Normal: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter);
instrs_of (PROG P) C M ! pc = Invoke M' n;
ek = (λs. stkAt s (stkLength (P, C, M) pc - Suc n) ≠ Null)⇩√ ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Enter) -(ek)→ (C, M, ⌊pc⌋, Normal)"
| CFG_Invoke_Check_NP_Exceptional: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter);
instrs_of (PROG P) C M ! pc = Invoke M' n;
pc' = (case (match_ex_table (PROG P) NullPointer pc (ex_table_of (PROG P) C M)) of
None ⇒ None
| Some (pc'', d) ⇒ ⌊pc''⌋);
ek = (λs. stkAt s (stkLength (P, C, M) pc - Suc n) = Null)⇩√ ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Enter) -(ek)→ (C, M, ⌊pc⌋, Exceptional pc' Enter)"
| CFG_Invoke_NP_prop: "⟦ C ≠ ClassMain P;
(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional None Enter);
instrs_of (PROG P) C M ! pc = Invoke M' n;
ek = ⇑(λs. s(Exception ↦ Value (Addr (addr_of_sys_xcpt NullPointer)))) ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Exceptional None Enter) -(ek)→ (C, M, None, Return)"
| CFG_Invoke_NP_handle: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter);
instrs_of (PROG P) C M ! pc = Invoke M' n;
ek = ⇑(λs. s(Exception := None)
(Stack (stkLength (P, C, M) pc' - 1) ↦ Value (Addr (addr_of_sys_xcpt NullPointer)))) ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter) -(ek)→ (C, M, ⌊pc'⌋, Enter)"
| CFG_Invoke_Call: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Normal);
instrs_of (PROG P) C M ! pc = Invoke M' n;
TYPING P C M ! pc = ⌊(ST, LT)⌋;
ST ! n = Class D';
PROG P ⊢ D' sees M':Ts→T = (mxs, mxl⇩0, is, xt) in D;
Q = (λ(s, ret). let r = stkAt s (stkLength (P, C, M) pc - Suc n);
C' = fst (the (heap_of s (the_Addr r)))
in D = fst (method (PROG P) C' M'));
paramDefs = (λs. s Heap)
# (λs. s (Stack (stkLength (P, C, M) pc - Suc n)))
# (rev (map (λi. (λs. s (Stack (stkLength (P, C, M) pc - Suc i)))) [0..<n]));
ek = Q:(C, M, pc)↪⇘(D,M')⇙paramDefs
⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Normal) -(ek)→ (D, M', None, Enter)"
| CFG_Invoke_False: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Normal);
instrs_of (PROG P) C M ! pc = Invoke M' n;
ek = (λs. False)⇩√
⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Normal) -(ek)→ (C, M, ⌊pc⌋, Return)"
| CFG_Invoke_Return_Check_Normal: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Return);
instrs_of (PROG P) C M ! pc = Invoke M' n;
(TYPING P) C M ! pc = ⌊(ST, LT)⌋;
ST ! n ≠ NT;
ek = (λs. s Exception = None)⇩√
⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Return) -(ek)→ (C, M, ⌊Suc pc⌋, Enter)"
| CFG_Invoke_Return_Check_Exceptional: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Return);
instrs_of (PROG P) C M ! pc = Invoke M' n;
match_ex_table (PROG P) Exc pc (ex_table_of (PROG P) C M) = ⌊(pc', diff)⌋;
pc' ≠ length (instrs_of (PROG P) C M);
ek = (λs. ∃v d. s Exception = ⌊v⌋ ∧
match_ex_table (PROG P) (cname_of (heap_of s) (the_Addr (the_Value v))) pc (ex_table_of (PROG P) C M) = ⌊(pc', d)⌋)⇩√
⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Return) -(ek)→ (C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Return)"
| CFG_Invoke_Return_Exceptional_handle: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Return);
instrs_of (PROG P) C M ! pc = Invoke M' n;
ek = ⇑(λs. s(Exception := None,
Stack (stkLength (P, C, M) pc' - 1) := s Exception)) ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Return) -(ek)→ (C, M, ⌊pc'⌋, Enter)"
| CFG_Invoke_Return_Exceptional_prop: "⟦ C ≠ ClassMain P;
(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Return);
instrs_of (PROG P) C M ! pc = Invoke M' n;
ek = (λs. ∃v. s Exception = ⌊v⌋ ∧
match_ex_table (PROG P) (cname_of (heap_of s) (the_Addr (the_Value v))) pc (ex_table_of (PROG P) C M) = None)⇩√ ⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Return) -(ek)→ (C, M, None, Return)"
| CFG_Return: "⟦ C ≠ ClassMain P; (P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter);
instrs_of (PROG P) C M ! pc = instr.Return;
ek = ⇑(λs. s(Stack 0 := s (Stack (stkLength (P, C, M) pc - 1))))
⟧
⟹ (P, C0, Main) ⊢ (C, M, ⌊pc⌋, Enter) -(ek)→ (C, M, None, Return)"
| CFG_Return_from_Method: "⟦ (P, C0, Main) ⊢ ⇒(C, M, None, Return);
(P, C0, Main) ⊢ (C', M', ⌊pc'⌋, Normal) -(Q':(C', M', pc')↪⇘(C,M)⇙ps)→ (C, M, None, Enter);
Q = (λ(s, ret). ret = (C', M', pc'));
stateUpdate = (λs s'. s'(Heap := s Heap,
Exception := s Exception,
Stack (stkLength (P, C', M') (Suc pc') - 1) := s (Stack 0))
);
ek = Q↩⇘(C, M)⇙stateUpdate
⟧
⟹ (P, C0, Main) ⊢ (C, M, None, Return) -(ek)→ (C', M', ⌊pc'⌋, Return)"
lemma JVMCFG_edge_det: "⟦ P ⊢ n -(et)→ n'; P ⊢ n -(et')→ n' ⟧ ⟹ et = et'"
by (erule JVMCFG.cases) (erule JVMCFG.cases, (fastforce dest: sees_method_fun)+)+
lemma sourcenode_reachable: "P ⊢ n -(ek)→ n' ⟹ P ⊢ ⇒n"
by (erule JVMCFG.cases, auto)
lemma targetnode_reachable:
assumes edge: "P ⊢ n -(ek)→ n'"
shows "P ⊢ ⇒n'"
proof -
from edge have "P ⊢ ⇒n"
by -(drule sourcenode_reachable)
with edge show ?thesis
by -(rule JVMCFG_reachable.intros)
qed
lemmas JVMCFG_reachable_inducts = JVMCFG_reachable.inducts[split_format (complete)]
lemma ClassMain_imp_MethodMain:
"(P, C0, Main) ⊢ (C', M', pc', nt') -ek→ (ClassMain P, M, pc, nt) ⟹ M = MethodMain P"
"(P, C0, Main) ⊢ ⇒(ClassMain P, M, pc, nt) ⟹ M = MethodMain P"
proof (induct P=="P" C0≡"C0" Main≡Main C' M' pc' nt' ek C''=="ClassMain P" M pc nt and
P=="P" C0≡"C0" Main≡Main C'=="ClassMain P" M pc nt
rule: JVMCFG_reachable_inducts)
case CFG_Return_from_Method
thus ?case
by (fastforce elim: JVMCFG.cases)
qed auto
lemma ClassMain_no_Call_target [dest!]:
"(P, C0, Main) ⊢ (C, M, pc, nt) -Q:(C', M', pc')↪⇘(D,M'')⇙paramDefs→ (ClassMain P, M''', pc'', nt')
⟹ False"
and
"(P, C0, Main) ⊢ ⇒(C, M, pc, nt) ⟹ True"
by (induct P C0 Main C M pc nt ek=="Q:(C', M', pc')↪⇘(D,M'')⇙paramDefs"
C''=="ClassMain P" M''' pc'' nt' and
P C0 Main C M pc nt
rule: JVMCFG_reachable_inducts) auto
lemma method_of_src_and_trg_exists:
"⟦ (P, C0, Main) ⊢ (C', M', pc', nt') -ek→ (C, M, pc, nt); C ≠ ClassMain P; C' ≠ ClassMain P ⟧
⟹ (∃Ts T mb. (PROG P) ⊢ C sees M:Ts→T = mb in C) ∧
(∃Ts T mb. (PROG P) ⊢ C' sees M':Ts→T = mb in C')"
and method_of_reachable_node_exists:
"⟦ (P, C0, Main) ⊢ ⇒(C, M, pc, nt); C ≠ ClassMain P ⟧
⟹ ∃Ts T mb. (PROG P) ⊢ C sees M:Ts→T = mb in C"
proof (induct rule: JVMCFG_reachable_inducts)
case CFG_Invoke_Call
thus ?case
by (blast dest: sees_method_idemp)
next
case (reachable_step P C0 Main C M pc nt ek C' M' pc' nt')
show ?case
proof (cases "C = ClassMain P")
case True
with ‹(P, C0, Main) ⊢ (C, M, pc, nt) -ek→ (C', M', pc', nt')› ‹C' ≠ ClassMain P›
show ?thesis
proof cases
case Main_Call
thus ?thesis
by (blast dest: sees_method_idemp)
qed auto
next
case False
with reachable_step show ?thesis
by simp
qed
qed simp_all
lemma "⟦ (P, C0, Main) ⊢ (C', M', pc', nt') -ek→ (C, M, pc, nt); C ≠ ClassMain P; C' ≠ ClassMain P ⟧
⟹ (case pc of None ⇒ True |
⌊pc''⌋ ⇒ (TYPING P) C M ! pc'' ≠ None ∧ pc'' < length (instrs_of (PROG P) C M)) ∧
(case pc' of None ⇒ True |
⌊pc''⌋ ⇒ (TYPING P) C' M' ! pc'' ≠ None ∧ pc'' < length (instrs_of (PROG P) C' M'))"
and instr_of_reachable_node_typable: "⟦ (P, C0, Main) ⊢ ⇒(C, M, pc, nt); C ≠ ClassMain P ⟧
⟹ case pc of None ⇒ True |
⌊pc''⌋ ⇒ (TYPING P) C M ! pc'' ≠ None ∧ pc'' < length (instrs_of (PROG P) C M)"
proof (induct rule: JVMCFG_reachable_inducts)
case (CFG_Load C P C0 Main M pc n ek)
from ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter)› ‹C ≠ ClassMain P›
obtain Ts T mxs mxl⇩0 "is" xt where "PROG P ⊢ C sees M:Ts→T = (mxs, mxl⇩0, is, xt) in C"
and "instrs_of (PROG P) C M = is"
by -(drule method_of_reachable_node_exists, auto)
with CFG_Load show ?case
by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
case (CFG_Store C P C0 Main M pc n ek)
from ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter)› ‹C ≠ ClassMain P›
obtain Ts T mxs mxl⇩0 "is" xt where "PROG P ⊢ C sees M:Ts→T = (mxs, mxl⇩0, is, xt) in C"
and "instrs_of (PROG P) C M = is"
by -(drule method_of_reachable_node_exists, auto)
with CFG_Store show ?case
by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
case (CFG_Push C P C0 Main M pc v ek)
from ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter)› ‹C ≠ ClassMain P›
obtain Ts T mxs mxl⇩0 "is" xt where "PROG P ⊢ C sees M:Ts→T = (mxs, mxl⇩0, is, xt) in C"
and "instrs_of (PROG P) C M = is"
by -(drule method_of_reachable_node_exists, auto)
with CFG_Push show ?case
by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
case (CFG_Pop C P C0 Main M pc ek)
from ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter)› ‹C ≠ ClassMain P›
obtain Ts T mxs mxl⇩0 "is" xt where "PROG P ⊢ C sees M:Ts→T = (mxs, mxl⇩0, is, xt) in C"
and "instrs_of (PROG P) C M = is"
by -(drule method_of_reachable_node_exists, auto)
with CFG_Pop show ?case
by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
case (CFG_IAdd C P C0 Main M pc ek)
from ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter)› ‹C ≠ ClassMain P›
obtain Ts T mxs mxl⇩0 "is" xt where "PROG P ⊢ C sees M:Ts→T = (mxs, mxl⇩0, is, xt) in C"
and "instrs_of (PROG P) C M = is"
by -(drule method_of_reachable_node_exists, auto)
with CFG_IAdd show ?case
by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
case (CFG_Goto C P C0 Main M pc i)
from ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter)› ‹C ≠ ClassMain P›
obtain Ts T mxs mxl⇩0 "is" xt where "PROG P ⊢ C sees M:Ts→T = (mxs, mxl⇩0, is, xt) in C"
and "instrs_of (PROG P) C M = is"
by -(drule method_of_reachable_node_exists, auto)
with CFG_Goto show ?case
by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
case (CFG_CmpEq C P C0 Main M pc ek)
from ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter)› ‹C ≠ ClassMain P›
obtain Ts T mxs mxl⇩0 "is" xt where "PROG P ⊢ C sees M:Ts→T = (mxs, mxl⇩0, is, xt) in C"
and "instrs_of (PROG P) C M = is"
by -(drule method_of_reachable_node_exists, auto)
with CFG_CmpEq show ?case
by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
case (CFG_IfFalse_False C P C0 Main M pc i ek)
from ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter)› ‹C ≠ ClassMain P›
obtain Ts T mxs mxl⇩0 "is" xt where "PROG P ⊢ C sees M:Ts→T = (mxs, mxl⇩0, is, xt) in C"
and "instrs_of (PROG P) C M = is"
by -(drule method_of_reachable_node_exists, auto)
with CFG_IfFalse_False show ?case
by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
case (CFG_IfFalse_True C P C0 Main M pc i ek)
from ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter)› ‹C ≠ ClassMain P›
obtain Ts T mxs mxl⇩0 "is" xt where "PROG P ⊢ C sees M:Ts→T = (mxs, mxl⇩0, is, xt) in C"
and "instrs_of (PROG P) C M = is"
by -(drule method_of_reachable_node_exists, auto)
with CFG_IfFalse_True show ?case
using [[simproc del: list_to_set_comprehension]] by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
case (CFG_New_Update C P C0 Main M pc Cl ek)
from ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Normal)› ‹C ≠ ClassMain P›
obtain Ts T mxs mxl⇩0 "is" xt where "PROG P ⊢ C sees M:Ts→T = (mxs, mxl⇩0, is, xt) in C"
and "instrs_of (PROG P) C M = is"
by -(drule method_of_reachable_node_exists, auto)
with CFG_New_Update show ?case
by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
case (CFG_New_Exceptional_handle C P C0 Main M pc pc' Cl ek)
hence "TYPING P C M ! pc ≠ None" and "pc < length (instrs_of (PROG P) C M)"
by simp_all
moreover from ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter)› ‹C ≠ ClassMain P›
obtain Ts T mxs mxl⇩0 where
"PROG P ⊢ C sees M:Ts→T = (mxs, mxl⇩0, instrs_of (PROG P) C M, ex_table_of (PROG P) C M) in C"
by (fastforce dest: method_of_reachable_node_exists)
with ‹pc < length (instrs_of (PROG P) C M)› ‹instrs_of (PROG P) C M ! pc = New Cl›
have "PROG P,T,mxs,length (instrs_of (PROG P) C M),ex_table_of (PROG P) C M
⊢ New Cl,pc :: TYPING P C M"
by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
moreover from ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter)› ‹C ≠ ClassMain P›
‹instrs_of (PROG P) C M ! pc = New Cl› obtain d'
where "match_ex_table (PROG P) OutOfMemory pc (ex_table_of (PROG P) C M) = ⌊(pc', d')⌋"
by cases (fastforce elim: JVMCFG.cases)
hence "∃(f, t, D, h, d)∈set (ex_table_of (PROG P) C M).
matches_ex_entry (PROG P) OutOfMemory pc (f, t, D, h, d) ∧ h = pc' ∧ d = d'"
by -(drule match_ex_table_SomeD)
ultimately show ?case using ‹instrs_of (PROG P) C M ! pc = New Cl›
by (fastforce simp: relevant_entries_def is_relevant_entry_def matches_ex_entry_def)
next
case (CFG_Getfield_Update C P C0 Main M pc F Cl ek)
from ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Normal)› ‹C ≠ ClassMain P›
obtain Ts T mxs mxl⇩0 "is" xt where "PROG P ⊢ C sees M:Ts→T = (mxs, mxl⇩0, is, xt) in C"
and "instrs_of (PROG P) C M = is"
by -(drule method_of_reachable_node_exists, auto)
with CFG_Getfield_Update show ?case
by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
case (CFG_Getfield_Exceptional_handle C P C0 Main M pc pc' F Cl ek)
hence "TYPING P C M ! pc ≠ None" and "pc < length (instrs_of (PROG P) C M)"
by simp_all
moreover from ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter)› ‹C ≠ ClassMain P›
obtain Ts T mxs mxl⇩0 where
"PROG P ⊢ C sees M:Ts→T = (mxs, mxl⇩0, instrs_of (PROG P) C M, ex_table_of (PROG P) C M) in C"
by (fastforce dest: method_of_reachable_node_exists)
with ‹pc < length (instrs_of (PROG P) C M)› ‹instrs_of (PROG P) C M ! pc = Getfield F Cl›
have "PROG P,T,mxs,length (instrs_of (PROG P) C M),ex_table_of (PROG P) C M
⊢ Getfield F Cl,pc :: TYPING P C M"
by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
moreover from ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter)› ‹C ≠ ClassMain P›
‹instrs_of (PROG P) C M ! pc = Getfield F Cl› obtain d'
where "match_ex_table (PROG P) NullPointer pc (ex_table_of (PROG P) C M) = ⌊(pc', d')⌋"
by cases (fastforce elim: JVMCFG.cases)
hence "∃(f, t, D, h, d)∈set (ex_table_of (PROG P) C M).
matches_ex_entry (PROG P) NullPointer pc (f, t, D, h, d) ∧ h = pc' ∧ d = d'"
by -(drule match_ex_table_SomeD)
ultimately show ?case using ‹instrs_of (PROG P) C M ! pc = Getfield F Cl›
by (fastforce simp: relevant_entries_def is_relevant_entry_def matches_ex_entry_def)
next
case (CFG_Putfield_Update C P C0 Main M pc F Cl ek)
from ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Normal)› ‹C ≠ ClassMain P›
obtain Ts T mxs mxl⇩0 "is" xt where "PROG P ⊢ C sees M:Ts→T = (mxs, mxl⇩0, is, xt) in C"
and "instrs_of (PROG P) C M = is"
by -(drule method_of_reachable_node_exists, auto)
with CFG_Putfield_Update show ?case
by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
case (CFG_Putfield_Exceptional_handle C P C0 Main M pc pc' F Cl ek)
hence "TYPING P C M ! pc ≠ None" and "pc < length (instrs_of (PROG P) C M)"
by simp_all
moreover from ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter)› ‹C ≠ ClassMain P›
obtain Ts T mxs mxl⇩0 where
"PROG P ⊢ C sees M:Ts→T = (mxs, mxl⇩0, instrs_of (PROG P) C M, ex_table_of (PROG P) C M) in C"
by (fastforce dest: method_of_reachable_node_exists)
with ‹pc < length (instrs_of (PROG P) C M)› ‹instrs_of (PROG P) C M ! pc = Putfield F Cl›
have "PROG P,T,mxs,length (instrs_of (PROG P) C M),ex_table_of (PROG P) C M
⊢ Putfield F Cl,pc :: TYPING P C M"
by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
moreover from ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter)› ‹C ≠ ClassMain P›
‹instrs_of (PROG P) C M ! pc = Putfield F Cl› obtain d'
where "match_ex_table (PROG P) NullPointer pc (ex_table_of (PROG P) C M) = ⌊(pc', d')⌋"
by cases (fastforce elim: JVMCFG.cases)
hence "∃(f, t, D, h, d)∈set (ex_table_of (PROG P) C M).
matches_ex_entry (PROG P) NullPointer pc (f, t, D, h, d) ∧ h = pc' ∧ d = d'"
by -(drule match_ex_table_SomeD)
ultimately show ?case using ‹instrs_of (PROG P) C M ! pc = Putfield F Cl›
by (fastforce simp: relevant_entries_def is_relevant_entry_def matches_ex_entry_def)
next
case (CFG_Checkcast_Check_Normal C P C0 Main M pc Cl ek)
from ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter)› ‹C ≠ ClassMain P›
obtain Ts T mxs mxl⇩0 "is" xt where "PROG P ⊢ C sees M:Ts→T = (mxs, mxl⇩0, is, xt) in C"
and "instrs_of (PROG P) C M = is"
by -(drule method_of_reachable_node_exists, auto)
with CFG_Checkcast_Check_Normal show ?case
by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
case (CFG_Checkcast_Exceptional_handle C P C0 Main M pc pc' Cl ek)
hence "TYPING P C M ! pc ≠ None" and "pc < length (instrs_of (PROG P) C M)"
by simp_all
moreover from ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter)› ‹C ≠ ClassMain P›
obtain Ts T mxs mxl⇩0 where
"PROG P ⊢ C sees M:Ts→T = (mxs, mxl⇩0, instrs_of (PROG P) C M, ex_table_of (PROG P) C M) in C"
by (fastforce dest: method_of_reachable_node_exists)
with ‹pc < length (instrs_of (PROG P) C M)› ‹instrs_of (PROG P) C M ! pc = Checkcast Cl›
have "PROG P,T,mxs,length (instrs_of (PROG P) C M),ex_table_of (PROG P) C M
⊢ Checkcast Cl,pc :: TYPING P C M"
by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
moreover from ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter)› ‹C ≠ ClassMain P›
‹instrs_of (PROG P) C M ! pc = Checkcast Cl› obtain d'
where "match_ex_table (PROG P) ClassCast pc (ex_table_of (PROG P) C M) = ⌊(pc', d')⌋"
by cases (fastforce elim: JVMCFG.cases)
hence "∃(f, t, D, h, d)∈set (ex_table_of (PROG P) C M).
matches_ex_entry (PROG P) ClassCast pc (f, t, D, h, d) ∧ h = pc' ∧ d = d'"
by -(drule match_ex_table_SomeD)
ultimately show ?case using ‹instrs_of (PROG P) C M ! pc = Checkcast Cl›
by (fastforce simp: relevant_entries_def is_relevant_entry_def matches_ex_entry_def)
next
case (CFG_Throw_handle C P C0 Main M pc pc' ek)
hence "TYPING P C M ! pc ≠ None" and "pc < length (instrs_of (PROG P) C M)"
by simp_all
moreover from ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter)› ‹C ≠ ClassMain P›
obtain Ts T mxs mxl⇩0 where
"PROG P ⊢ C sees M:Ts→T = (mxs, mxl⇩0, instrs_of (PROG P) C M, ex_table_of (PROG P) C M) in C"
by (fastforce dest: method_of_reachable_node_exists)
with ‹pc < length (instrs_of (PROG P) C M)› ‹instrs_of (PROG P) C M ! pc = Throw›
have "PROG P,T,mxs,length (instrs_of (PROG P) C M),ex_table_of (PROG P) C M
⊢ Throw,pc :: TYPING P C M"
by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
moreover from ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter)› ‹C ≠ ClassMain P›
‹instrs_of (PROG P) C M ! pc = Throw› obtain d' Exc
where "match_ex_table (PROG P) Exc pc (ex_table_of (PROG P) C M) = ⌊(pc', d')⌋"
by cases (fastforce elim: JVMCFG.cases)
hence "∃(f, t, D, h, d)∈set (ex_table_of (PROG P) C M).
matches_ex_entry (PROG P) Exc pc (f, t, D, h, d) ∧ h = pc' ∧ d = d'"
by -(drule match_ex_table_SomeD)
ultimately show ?case using ‹instrs_of (PROG P) C M ! pc = Throw›
by (fastforce simp: relevant_entries_def is_relevant_entry_def matches_ex_entry_def)
next
case (CFG_Invoke_NP_handle C P C0 Main M pc pc' M' n ek)
hence "TYPING P C M ! pc ≠ None" and "pc < length (instrs_of (PROG P) C M)"
by simp_all
moreover from ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter)› ‹C ≠ ClassMain P›
obtain Ts T mxs mxl⇩0 where
"PROG P ⊢ C sees M:Ts→T = (mxs, mxl⇩0, instrs_of (PROG P) C M, ex_table_of (PROG P) C M) in C"
by (fastforce dest: method_of_reachable_node_exists)
with ‹pc < length (instrs_of (PROG P) C M)› ‹instrs_of (PROG P) C M ! pc = Invoke M' n›
have "PROG P,T,mxs,length (instrs_of (PROG P) C M),ex_table_of (PROG P) C M
⊢ Invoke M' n,pc :: TYPING P C M"
by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
moreover from ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter)› ‹C ≠ ClassMain P›
‹instrs_of (PROG P) C M ! pc = Invoke M' n› obtain d'
where "match_ex_table (PROG P) NullPointer pc (ex_table_of (PROG P) C M) = ⌊(pc', d')⌋"
by cases (fastforce elim: JVMCFG.cases)
hence "∃(f, t, D, h, d)∈set (ex_table_of (PROG P) C M).
matches_ex_entry (PROG P) NullPointer pc (f, t, D, h, d) ∧ h = pc' ∧ d = d'"
by -(drule match_ex_table_SomeD)
ultimately show ?case using ‹instrs_of (PROG P) C M ! pc = Invoke M' n›
by (fastforce simp: relevant_entries_def is_relevant_entry_def matches_ex_entry_def)
next
case (CFG_Invoke_Return_Exceptional_handle C P C0 Main M pc pc' M' n ek)
hence "TYPING P C M ! pc ≠ None" and "pc < length (instrs_of (PROG P) C M)"
by simp_all
moreover from ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Return)› ‹C ≠ ClassMain P›
obtain Ts T mxs mxl⇩0 where
"PROG P ⊢ C sees M:Ts→T = (mxs, mxl⇩0, instrs_of (PROG P) C M, ex_table_of (PROG P) C M) in C"
by (fastforce dest: method_of_reachable_node_exists)
with ‹pc < length (instrs_of (PROG P) C M)› ‹instrs_of (PROG P) C M ! pc = Invoke M' n›
have "PROG P,T,mxs,length (instrs_of (PROG P) C M),ex_table_of (PROG P) C M
⊢ Invoke M' n,pc :: TYPING P C M"
by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
moreover from ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Return)› ‹C ≠ ClassMain P›
‹instrs_of (PROG P) C M ! pc = Invoke M' n› obtain d' Exc
where "match_ex_table (PROG P) Exc pc (ex_table_of (PROG P) C M) = ⌊(pc', d')⌋"
by cases (fastforce elim: JVMCFG.cases)
hence "∃(f, t, D, h, d)∈set (ex_table_of (PROG P) C M).
matches_ex_entry (PROG P) Exc pc (f, t, D, h, d) ∧ h = pc' ∧ d = d'"
by -(drule match_ex_table_SomeD)
ultimately show ?case using ‹instrs_of (PROG P) C M ! pc = Invoke M' n›
by (fastforce simp: relevant_entries_def is_relevant_entry_def matches_ex_entry_def)
next
case (CFG_Invoke_Return_Check_Normal C P C0 Main M pc M' n ST LT ek)
from ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Return)› ‹C ≠ ClassMain P›
obtain Ts T mxs mxl⇩0 "is" xt where "PROG P ⊢ C sees M:Ts→T = (mxs, mxl⇩0, is, xt) in C"
and "instrs_of (PROG P) C M = is"
by -(drule method_of_reachable_node_exists, auto)
with CFG_Invoke_Return_Check_Normal show ?case
by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
case (Method_LTrue P C0 Main C M)
from ‹(P, C0, Main) ⊢ ⇒(C, M, None, Enter)› ‹C ≠ ClassMain P›
obtain Ts T mxs mxl⇩0 "is" xt where "PROG P ⊢ C sees M:Ts→T = (mxs, mxl⇩0, is, xt) in C"
and "instrs_of (PROG P) C M = is"
by -(drule method_of_reachable_node_exists, auto)
with Method_LTrue show ?case
by (fastforce dest!: wt_jvm_prog_impl_wt_start [OF wf_jvmprog_is_wf_typ] simp: wt_start_def)
next
case (reachable_step P C0 Main C M opc nt ek C' M' opc' nt')
thus ?case
by (cases "C = ClassMain P") (fastforce elim: JVMCFG.cases, simp)
qed simp_all
lemma reachable_node_impl_wt_instr:
assumes "(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, nt)"
and "C ≠ ClassMain P"
shows "∃T mxs mpc xt. PROG P,T,mxs,mpc,xt ⊢ (instrs_of (PROG P) C M ! pc),pc :: TYPING P C M"
proof -
from ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, nt)›
method_of_reachable_node_exists [of P C0 Main C M "⌊pc⌋" nt]
instr_of_reachable_node_typable [of P C0 Main C M "⌊pc⌋" nt]
obtain Ts T mxs mxl⇩0 "is" xt
where "PROG P ⊢ C sees M:Ts→T = (mxs, mxl⇩0, is, xt) in C"
and "TYPING P C M ! pc ≠ None"
and "pc < length (instrs_of (PROG P) C M)"
by fastforce+
with wf_jvmprog_is_wf_typ [of P]
have "PROG P,T,mxs,length is,xt ⊢ instrs_of (PROG P) C M ! pc,pc :: TYPING P C M"
by (fastforce dest!: wt_jvm_prog_impl_wt_instr)
thus ?thesis
by blast
qed
lemma
"⟦ (P, C0, Main) ⊢ (C, M, pc, nt) -ek→ (C', M', pc', nt'); C ≠ ClassMain P ∨ C' ≠ ClassMain P ⟧
⟹ ∃T mb D. PROG P ⊢ C0 sees Main:[]→T = mb in D"
and reachable_node_impl_Main_ex:
"⟦ (P, C0, Main) ⊢ ⇒(C, M, pc, nt); C ≠ ClassMain P⟧
⟹ ∃T mb D. PROG P ⊢ C0 sees Main:[]→T = mb in D"
by (induct rule: JVMCFG_reachable_inducts) fastforce+
end
Theory JVMInterpretation
theory JVMInterpretation imports JVMCFG "../StaticInter/CFGExit" begin
section ‹Instatiation of the ‹CFG› locale›
abbreviation sourcenode :: "cfg_edge ⇒ cfg_node"
where "sourcenode e ≡ fst e"
abbreviation targetnode :: "cfg_edge ⇒ cfg_node"
where "targetnode e ≡ snd(snd e)"
abbreviation kind :: "cfg_edge ⇒ (var, val, cname × mname × pc, cname × mname) edge_kind"
where "kind e ≡ fst(snd e)"
definition valid_edge :: "jvm_method ⇒ cfg_edge ⇒ bool"
where "valid_edge P e ≡ P ⊢ (sourcenode e) -(kind e)→ (targetnode e)"
fun methods :: "cname ⇒ JVMInstructions.jvm_method mdecl list ⇒ ((cname × mname) × var list × var list) list"
where "methods C [] = []"
| "methods C ((M, Ts, T, mb) # ms)
= ((C, M), Heap # (map Local [0..<Suc (length Ts)]), [Heap, Stack 0, Exception]) # (methods C ms)"
fun procs :: "jvm_prog ⇒ ((cname × mname) × var list × var list) list"
where "procs [] = []"
|"procs ((C, D, fs, ms) # P) = (methods C ms) @ (procs P)"
lemma in_set_methodsI: "map_of ms M = ⌊(Ts, T, mxs, mxl⇩0, is, xt)⌋
⟹ ((C', M), Heap # map Local [0..<length Ts] @ [Local (length Ts)], [Heap, Stack 0, Exception])
∈ set (methods C' ms)"
by (induct rule: methods.induct) (auto split: if_split_asm)
lemma in_methods_in_msD: "((C, M), ins, outs) ∈ set (methods D ms)
⟹ M ∈ set (map fst ms) ∧ D = C"
by (induct ms) auto
lemma in_methods_in_msD': "((C, M), ins, outs) ∈ set (methods D ms)
⟹ ∃Ts T mb. (M, Ts, T, mb) ∈ set ms
∧ D = C
∧ ins = Heap # (map Local [0..<Suc (length Ts)])
∧ outs = [Heap, Stack 0, Exception]"
by (induct rule: methods.induct) fastforce+
lemma in_set_methodsE:
assumes "((C, M), ins, outs) ∈ set (methods D ms)"
obtains Ts T mb
where "(M, Ts, T, mb) ∈ set ms"
and "D = C"
and "ins = Heap # (map Local [0..<Suc (length Ts)])"
and "outs = [Heap, Stack 0, Exception]"
using assms
by (induct ms) fastforce+
lemma in_set_procsI:
assumes sees: "P ⊢ D sees M: Ts→T = mb in D"
and ins_def: "ins = Heap # map Local [0..<Suc (length Ts)]"
and outs_def: "outs = [Heap, Stack 0, Exception]"
shows "((D, M), ins, outs) ∈ set (procs P)"
proof -
from sees obtain D' fs ms where "map_of P D = ⌊(D', fs, ms)⌋" and "map_of ms M = ⌊(Ts, T, mb)⌋"
by (fastforce dest: visible_method_exists simp: class_def)
hence "(D, D', fs, ms) ∈ set P"
by -(drule map_of_SomeD)
thus ?thesis
proof (induct P)
case Nil thus ?case by simp
next
case (Cons Class P)
with ins_def outs_def ‹map_of ms M = ⌊(Ts, T, mb)⌋› show ?case
by (cases Class, cases mb) (auto intro: in_set_methodsI)
qed
qed
lemma distinct_methods: "distinct (map fst ms) ⟹ distinct (map fst (methods C ms))"
proof (induct ms)
case Nil thus ?case by simp
next
case (Cons M ms)
thus ?case
by (cases M) (auto dest: in_methods_in_msD)
qed
lemma in_set_procsD:
"((C, M), ins, out) ∈ set (procs P) ⟹ ∃D fs ms. (C, D, fs, ms) ∈ set P ∧ M ∈ set (map fst ms)"
proof (induct P)
case Nil thus ?case by simp
next
case (Cons Class P)
thus ?case
by (cases Class) (fastforce dest: in_methods_in_msD intro: rev_image_eqI)
qed
lemma in_set_procsE':
assumes "((C, M), ins, outs) ∈ set (procs P)"
obtains D fs ms Ts T mb
where "(C, D, fs, ms) ∈ set P"
and "(M, Ts, T, mb) ∈ set ms"
and "ins = Heap # (map (λn. Local n) [0..<Suc (length Ts)])"
and "outs = [Heap, Stack 0, Exception]"
using assms
by (induct P) (fastforce elim: in_set_methodsE)+
lemma distinct_Local_vars [simp]: "distinct (map Local [0..<n])"
by (induct n) auto
lemma distinct_Stack_vars [simp]: "distinct (map Stack [0..<n])"
by (induct n) auto
inductive_set get_return_edges :: "wf_jvmprog ⇒ cfg_edge ⇒ cfg_edge set"
for P :: "wf_jvmprog"
and a :: "cfg_edge"
where
"kind a = Q:(C, M, pc)↪⇘(D, M')⇙paramDefs
⟹ ((D, M', None, Return),
(λ(s, ret). ret = (C, M, pc))↩⇘(D, M')⇙(λs s'. s'(Heap := s Heap, Exception := s Exception,
Stack (stkLength (P, C, M) (Suc pc) - 1) := s (Stack 0))),
(C, M, ⌊pc⌋, Return)) ∈ (get_return_edges P a)"
lemma get_return_edgesE [elim!]:
assumes "a ∈ get_return_edges P a'"
obtains Q C M pc D M' paramDefs where
"kind a' = Q:(C, M, pc)↪⇘(D, M')⇙paramDefs"
and "a = ((D, M', None, Return),
(λ(s, ret). ret = (C, M, pc))↩⇘(D, M')⇙(λs s'. s'(Heap := s Heap, Exception := s Exception,
Stack (stkLength (P, C, M) (Suc pc) - 1) := s (Stack 0))),
(C, M, ⌊pc⌋, Return))"
using assms
by -(cases a, cases a', clarsimp, erule get_return_edges.cases, fastforce)
lemma distinct_class_names: "distinct_fst (PROG P)"
using wf_jvmprog_is_wf_typ [of P]
by (clarsimp simp: wf_jvm_prog_phi_def wf_prog_def)
lemma distinct_method_names:
"class (PROG P) C = ⌊(D, fs, ms)⌋ ⟹ distinct_fst ms"
using wf_jvmprog_is_wf_typ [of P]
unfolding wf_jvm_prog_phi_def
by (fastforce dest: class_wf simp: wf_cdecl_def)
lemma distinct_fst_is_distinct_fst: "distinct_fst = BasicDefs.distinct_fst"
by (simp add: distinct_fst_def BasicDefs.distinct_fst_def)
lemma ClassMain_not_in_set_PROG [dest!]: "(ClassMain P, D, fs, ms) ∈ set (PROG P) ⟹ False"
using distinct_class_names [of P] ClassMain_is_no_class [of P]
by (fastforce intro: map_of_SomeI simp: class_def)
lemma in_set_procsE:
assumes "((C, M), ins, outs) ∈ set (procs (PROG P))"
obtains D fs ms Ts T mb
where "class (PROG P) C = ⌊(D, fs, ms)⌋"
and "PROG P ⊢ C sees M:Ts→T = mb in C"
and "ins = Heap # (map (λn. Local n) [0..<Suc (length Ts)])"
and "outs = [Heap, Stack 0, Exception]"
proof -
from ‹((C, M), ins, outs) ∈ set (procs (PROG P))›
obtain D fs ms Ts T mxs mxl⇩0 "is" xt
where "(C, D, fs, ms) ∈ set (PROG P)"
and "(M, Ts, T, mxs, mxl⇩0, is, xt) ∈ set ms"
and "ins = Heap # (map (λn. Local n) [0..<Suc (length Ts)])"
and "outs = [Heap, Stack 0, Exception]"
by (fastforce elim: in_set_procsE')
moreover from ‹(C, D, fs, ms) ∈ set (PROG P)› distinct_class_names [of P]
have "class (PROG P) C = ⌊(D, fs, ms)⌋"
by (fastforce intro: map_of_SomeI simp: class_def)
moreover from wf_jvmprog_is_wf_typ [of P]
‹(M, Ts, T, mxs, mxl⇩0, is, xt) ∈ set ms› ‹(C, D, fs, ms) ∈ set (PROG P)›
have "PROG P ⊢ C sees M:Ts→T = (mxs, mxl⇩0, is, xt) in C"
by (fastforce intro: mdecl_visible simp: wf_jvm_prog_phi_def)
ultimately show ?thesis using that by blast
qed
declare has_method_def [simp]
interpretation JVMCFG_Interpret:
CFG "sourcenode" "targetnode" "kind" "valid_edge (P, C0, Main)"
"(ClassMain P, MethodMain P, None, Enter)"
"(λ(C, M, pc, type). (C, M))" "get_return_edges P"
"((ClassMain P, MethodMain P),[],[]) # procs (PROG P)" "(ClassMain P, MethodMain P)"
for P C0 Main
proof (unfold_locales)
fix e
assume "valid_edge (P, C0, Main) e"
and "targetnode e = (ClassMain P, MethodMain P, None, Enter)"
thus False
by (auto simp: valid_edge_def)(erule JVMCFG.cases, auto)+
next
show "(λ(C, M, pc, type). (C, M)) (ClassMain P, MethodMain P, None, Enter) =
(ClassMain P, MethodMain P)"
by simp
next
fix a Q r p fs
assume "valid_edge (P, C0, Main) a"
and "kind a = Q:r↪⇘p⇙fs"
and "sourcenode a = (ClassMain P, MethodMain P, None, Enter)"
thus False
by (auto simp: valid_edge_def) (erule JVMCFG.cases, auto)
next
fix a a'
assume "valid_edge (P, C0, Main) a"
and "valid_edge (P, C0, Main) a'"
and "sourcenode a = sourcenode a'"
and "targetnode a = targetnode a'"
thus "a = a'"
by (cases a, cases a') (fastforce simp: valid_edge_def dest: JVMCFG_edge_det)
next
fix a Q r f
assume "valid_edge (P, C0, Main) a"
and "kind a = Q:r↪⇘(ClassMain P, MethodMain P)⇙f"
thus False
by (clarsimp simp: valid_edge_def) (erule JVMCFG.cases, auto)
next
fix a Q' f'
assume "valid_edge (P, C0, Main) a" and "kind a = Q'↩⇘(ClassMain P, MethodMain P)⇙f'"
thus False
by (clarsimp simp: valid_edge_def) (erule JVMCFG.cases, auto)+
next
fix a Q r p fs
assume "valid_edge (P, C0, Main) a"
and "kind a = Q:r↪⇘p⇙fs"
then obtain C M pc nt C' M' pc' nt'
where "(P, C0, Main) ⊢ (C, M, pc, nt) -Q:r↪⇘p⇙fs→ (C', M', pc', nt')"
by (cases a) (clarsimp simp: valid_edge_def)
thus "∃ins outs.
(p, ins, outs) ∈ set (((ClassMain P, MethodMain P), [], []) # procs (PROG P))"
proof cases
case (Main_Call T mxs mxl0 "is" xt initParams)
hence "((C', Main), [Heap, Local 0], [Heap, Stack 0, Exception]) ∈ set (procs (PROG P))"
and "p = (C', Main)"
by (auto intro: in_set_procsI dest: sees_method_idemp)
thus ?thesis by fastforce
next
case (CFG_Invoke_Call _ n _ _ _ Ts)
hence "((C', M'), Heap # map (λn. Local n) [0..<Suc (length Ts)],
[Heap, Stack 0, Exception]) ∈ set (procs (PROG P))"
and "p = (C',M')"
by (auto intro: in_set_procsI dest: sees_method_idemp)
thus ?thesis by fastforce
qed simp_all
next
fix a
assume "valid_edge (P, C0, Main) a" and "intra_kind (kind a)"
thus "(λ(C, M, pc, type). (C, M)) (sourcenode a) =
(λ(C, M, pc, type). (C, M)) (targetnode a)"
by (clarsimp simp: valid_edge_def) (erule JVMCFG.cases, auto simp: intra_kind_def)
next
fix a Q r p fs
assume "valid_edge (P, C0, Main) a" and "kind a = Q:r↪⇘p⇙fs"
thus "(λ(C, M, pc, type). (C, M)) (targetnode a) = p"
by (clarsimp simp: valid_edge_def) (erule JVMCFG.cases, auto)
next
fix a Q' p f'
assume "valid_edge (P, C0, Main) a" and "kind a = Q'↩⇘p⇙f'"
thus "(λ(C, M, pc, type). (C, M)) (sourcenode a) = p"
by (clarsimp simp: valid_edge_def) (erule JVMCFG.cases, auto)
next
fix a Q r p fs
assume "valid_edge (P, C0, Main) a" and "kind a = Q:r↪⇘p⇙fs"
thus "∀a'. valid_edge (P, C0, Main) a' ∧ targetnode a' = targetnode a
⟶ (∃Qx rx fsx. kind a' = Qx:rx↪⇘p⇙fsx)"
by (cases a, clarsimp simp: valid_edge_def) (erule JVMCFG.cases, auto)+
next
fix a Q' p f'
assume "valid_edge (P, C0, Main) a" and "kind a = Q'↩⇘p⇙f'"
thus "∀a'. valid_edge (P, C0, Main) a' ∧ sourcenode a' = sourcenode a
⟶ (∃Qx fx. kind a' = Qx↩⇘p⇙fx)"
by (cases a, clarsimp simp: valid_edge_def) (erule JVMCFG.cases, auto)+
next
fix a Q r p fs
assume "valid_edge (P, C0, Main) a" and "kind a = Q:r↪⇘p⇙fs"
then have "∃a'. a' ∈ get_return_edges P a"
by (cases p, cases r) (fastforce intro: get_return_edges.intros)
then show "get_return_edges P a ≠ {}"
by (simp only: ex_in_conv) simp
next
fix a a'
assume "valid_edge (P, C0, Main) a" "a' ∈ get_return_edges P a"
then obtain Q C M pc D M' paramDefs
where "(P, C0, Main) ⊢ sourcenode a -Q:(C, M, pc)↪⇘(D, M')⇙paramDefs→ targetnode a"
and "kind a = Q:(C, M, pc)↪⇘(D, M')⇙paramDefs"
and a'_def: "a' = ((D, M', None, nodeType.Return),
λ(s, ret).
ret = (C, M, pc)↩⇘(D, M')⇙λs s'. s'(Heap := s Heap, Exception := s Exception,
Stack (stkLength (P, C, M) (Suc pc) - 1) := s (Stack 0)),
C, M, ⌊pc⌋, nodeType.Return)"
by (fastforce simp: valid_edge_def)
thus "valid_edge (P, C0, Main) a'"
proof cases
case (Main_Call T mxs mxl0 "is" xt D')
hence "D = D'" and "M' = Main"
by simp_all
with ‹(P, C0, Main) ⊢ ⇒(ClassMain P, MethodMain P, ⌊0⌋, Normal)›
‹PROG P ⊢ C0 sees Main: []→T = (mxs, mxl0, is, xt) in D'›
have "(P, C0, Main) ⊢ ⇒(D, M', None, Enter)"
by -(rule reachable_step, fastforce, fastforce intro: JVMCFG_reachable.Main_Call)
hence "(P, C0, Main) ⊢ ⇒(D, M', None, nodeType.Return)"
by -(rule reachable_step, fastforce, fastforce intro: JVMCFG_reachable.Method_LFalse)
with a'_def Main_Call show ?thesis
by (fastforce intro: CFG_Return_from_Method JVMCFG_reachable.Main_Call simp: valid_edge_def)
next
case (CFG_Invoke_Call _ _ _ M'' _ _ _ _ _ _ _ _ _ _ D')
hence "D = D'" and "M' = M''"
by simp_all
with CFG_Invoke_Call
have "(P, C0, Main) ⊢ ⇒(D, M', None, Enter)"
by -(rule reachable_step, fastforce, fastforce intro: JVMCFG_reachable.CFG_Invoke_Call)
hence "(P, C0, Main) ⊢ ⇒(D, M', None, nodeType.Return)"
by -(rule reachable_step, fastforce, fastforce intro: JVMCFG_reachable.Method_LFalse)
with a'_def CFG_Invoke_Call show ?thesis
by (fastforce intro: CFG_Return_from_Method JVMCFG_reachable.CFG_Invoke_Call
simp: valid_edge_def)
qed simp_all
next
fix a a'
assume "valid_edge (P, C0, Main) a" and "a' ∈ get_return_edges P a"
thus "∃Q r p fs. kind a = Q:r↪⇘p⇙fs"
by clarsimp
next
fix a Q r p fs a'
assume "valid_edge (P, C0, Main) a" and "kind a = Q:r↪⇘p⇙fs" and "a' ∈ get_return_edges P a"
thus "∃Q' f'. kind a' = Q'↩⇘p⇙f'"
by clarsimp
next
fix a Q' p f'
assume "valid_edge (P, C0, Main) a" and "kind a = Q'↩⇘p⇙f'"
show "∃!a'. valid_edge (P, C0, Main) a' ∧
(∃Q r fs. kind a' = Q:r↪⇘p⇙fs) ∧ a ∈ get_return_edges P a'"
proof (rule ex_ex1I)
from ‹valid_edge (P, C0, Main) a›
have "(P, C0, Main) ⊢ sourcenode a -kind a→ targetnode a"
by (clarsimp simp: valid_edge_def)
from this ‹kind a = Q'↩⇘p⇙f'›
show "∃a'. valid_edge (P, C0, Main) a' ∧ (∃Q r fs. kind a' = Q:r↪⇘p⇙fs)
∧ a ∈ get_return_edges P a'"
by cases (cases a, fastforce intro: get_return_edges.intros[simplified] simp: valid_edge_def)+
next
fix a' a''
assume "valid_edge (P, C0, Main) a'
∧ (∃Q r fs. kind a' = Q:r↪⇘p⇙fs) ∧ a ∈ get_return_edges P a'"
and "valid_edge (P, C0, Main) a''
∧ (∃Q r fs. kind a'' = Q:r↪⇘p⇙fs) ∧ a ∈ get_return_edges P a''"
thus "a' = a''"
by (cases a', cases a'', clarsimp simp: valid_edge_def)
(erule JVMCFG.cases, simp_all, clarsimp? )+
qed
next
fix a a'
assume "valid_edge (P, C0, Main) a" and "a' ∈ get_return_edges P a"
thus "∃a''. valid_edge (P, C0, Main) a'' ∧
sourcenode a'' = targetnode a ∧
targetnode a'' = sourcenode a' ∧ kind a'' = (λcf. False)⇩√"
by (clarsimp simp: valid_edge_def) (erule JVMCFG.cases, auto intro: JVMCFG_reachable.intros)
next
fix a a'
assume "valid_edge (P, C0, Main) a" and "a' ∈ get_return_edges P a"
thus "∃a''. valid_edge (P, C0, Main) a'' ∧
sourcenode a'' = sourcenode a ∧
targetnode a'' = targetnode a' ∧ kind a'' = (λcf. False)⇩√"
by (clarsimp simp: valid_edge_def) (erule JVMCFG.cases, auto intro: JVMCFG_reachable.intros)
next
fix a Q r p fs
assume "valid_edge (P, C0, Main) a" and "kind a = Q:r↪⇘p⇙fs"
hence call: "(P, C0, Main) ⊢ sourcenode a -Q:r↪⇘p⇙fs→ targetnode a"
by (clarsimp simp: valid_edge_def)
show "∃!a'. valid_edge (P, C0, Main) a' ∧
sourcenode a' = sourcenode a ∧ intra_kind (kind a')"
proof (rule ex_ex1I)
from call
show "∃a'. valid_edge (P, C0, Main) a' ∧ sourcenode a' = sourcenode a ∧ intra_kind (kind a')"
by cases (fastforce intro: JVMCFG_reachable.intros simp: intra_kind_def valid_edge_def)+
next
fix a' a''
assume "valid_edge (P, C0, Main) a' ∧ sourcenode a' = sourcenode a ∧ intra_kind (kind a')"
and "valid_edge (P, C0, Main) a'' ∧ sourcenode a'' = sourcenode a ∧ intra_kind (kind a'')"
with call show "a' = a''"
by (cases a, cases a', cases a'', clarsimp simp: valid_edge_def intra_kind_def)
(erule JVMCFG.cases, simp_all, clarsimp?)+
qed
next
fix a Q' p f'
assume "valid_edge (P, C0, Main) a" and "kind a = Q'↩⇘p⇙f'"
hence return: "(P, C0, Main) ⊢ sourcenode a -Q'↩⇘p⇙f'→ targetnode a"
by (clarsimp simp: valid_edge_def)
show "∃!a'. valid_edge (P, C0, Main) a' ∧
targetnode a' = targetnode a ∧ intra_kind (kind a')"
proof (rule ex_ex1I)
from return
show "∃a'. valid_edge (P, C0, Main) a' ∧ targetnode a' = targetnode a ∧ intra_kind (kind a')"
proof cases
case (CFG_Return_from_Method C M C' M' pc' Q'' ps Q stateUpdate)
hence [simp]: "Q = Q'" and [simp]: "p = (C, M)" and [simp]: "f' = stateUpdate"
by simp_all
from ‹(P, C0, Main) ⊢ (C', M', ⌊pc'⌋, Normal) -Q'':(C', M', pc')↪⇘(C, M)⇙ps→ (C, M, None, Enter)›
have invoke_reachable: "(P, C0, Main) ⊢ ⇒(C', M', ⌊pc'⌋, Normal)"
by -(drule sourcenode_reachable)
show ?thesis
proof (cases "C' = ClassMain P")
case True
with invoke_reachable CFG_Return_from_Method show ?thesis
by -(erule JVMCFG.cases, simp_all,
fastforce intro: Main_Call_LFalse simp: valid_edge_def intra_kind_def)
next
case False
with invoke_reachable CFG_Return_from_Method show ?thesis
by -(erule JVMCFG.cases, simp_all,
fastforce intro: CFG_Invoke_False simp: valid_edge_def intra_kind_def)
qed
qed simp_all
next
fix a' a''
assume "valid_edge (P, C0, Main) a' ∧ targetnode a' = targetnode a ∧ intra_kind (kind a')"
and "valid_edge (P, C0, Main) a'' ∧ targetnode a'' = targetnode a ∧ intra_kind (kind a'')"
with return show "a' = a''"
by (cases, auto, cases a, cases a', cases a'', clarsimp simp: valid_edge_def intra_kind_def)
(erule JVMCFG.cases, simp_all, clarsimp?)+
qed
next
fix a a' Q⇩1 r⇩1 p fs⇩1 Q⇩2 r⇩2 fs⇩2
assume "valid_edge (P, C0, Main) a" and "valid_edge (P, C0, Main) a'"
and "kind a = Q⇩1:r⇩1↪⇘p⇙fs⇩1" and "kind a' = Q⇩2:r⇩2↪⇘p⇙fs⇩2"
thus "targetnode a = targetnode a'"
by (cases a, cases a', clarsimp simp: valid_edge_def)
(erule JVMCFG.cases, simp_all, clarsimp?)+
next
from distinct_method_names [of P] distinct_class_names [of P]
have "⋀C D fs ms. (C, D, fs, ms) ∈ set (PROG P) ⟹ distinct_fst ms"
by (fastforce intro: map_of_SomeI simp: class_def)
moreover {
fix P
assume "distinct_fst (P :: jvm_prog)"
and "⋀C D fs ms. (C, D, fs, ms) ∈ set P ⟹ distinct_fst ms"
hence "distinct_fst (procs P)"
by (induct P, simp)
(fastforce intro: equals0I rev_image_eqI dest: in_methods_in_msD in_set_procsD
simp: distinct_methods distinct_fst_def)
}
ultimately have "distinct_fst (procs (PROG P))" using distinct_class_names [of P]
by blast
hence "BasicDefs.distinct_fst (procs (PROG P))"
by (simp add: distinct_fst_is_distinct_fst)
thus "BasicDefs.distinct_fst (((ClassMain P, MethodMain P), [], []) # procs (PROG P))"
by (fastforce elim: in_set_procsE)
next
fix C M P p ins outs
assume "(p, ins, outs) ∈ set (((C, M), [], []) # procs P)"
thus "distinct ins"
proof (induct P)
case Nil
thus ?case by simp
next
case (Cons Cl P)
then obtain C D fs ms where "Cl = (C, D, fs, ms)"
by (cases Cl) blast
with Cons show ?case
by hypsubst_thin (induct ms, auto)
qed
next
fix C M P p ins outs
assume "(p, ins, outs) ∈ set (((C, M), [], []) # procs P)"
thus "distinct outs"
proof (induct "P")
case Nil
thus ?case by simp
next
case (Cons Cl P)
then obtain C D fs ms where "Cl = (C, D, fs, ms)"
by (cases Cl) blast
with Cons show ?case
by hypsubst_thin (induct ms, auto)
qed
qed
interpretation JVMCFG_Exit_Interpret:
CFGExit "sourcenode" "targetnode" "kind" "valid_edge (P, C0, Main)"
"(ClassMain P, MethodMain P, None, Enter)"
"(λ(C, M, pc, type). (C, M))" "get_return_edges P"
"((ClassMain P, MethodMain P),[],[]) # procs (PROG P)"
"(ClassMain P, MethodMain P)" "(ClassMain P, MethodMain P, None, Return)"
for P C0 Main
proof (unfold_locales)
fix a
assume "valid_edge (P, C0, Main) a"
and "sourcenode a = (ClassMain P, MethodMain P, None, nodeType.Return)"
thus False
by (cases a, clarsimp simp: valid_edge_def) (erule JVMCFG.cases, simp_all, clarsimp)
next
show "(λ(C, M, pc, type). (C, M)) (ClassMain P, MethodMain P, None, nodeType.Return) =
(ClassMain P, MethodMain P)"
by simp
next
fix a Q p f
assume "valid_edge (P, C0, Main) a"
and "kind a = Q↩⇘p⇙f"
and "targetnode a = (ClassMain P, MethodMain P, None, nodeType.Return)"
thus False
by (cases a, clarsimp simp: valid_edge_def) (erule JVMCFG.cases, simp_all)
next
show "∃a. valid_edge (P, C0, Main) a ∧
sourcenode a = (ClassMain P, MethodMain P, None, Enter) ∧
targetnode a = (ClassMain P, MethodMain P, None, nodeType.Return) ∧
kind a = (λs. False)⇩√"
by (fastforce intro: JVMCFG_reachable.intros simp: valid_edge_def)
qed
end
Theory JVMCFG_wf
theory JVMCFG_wf imports JVMInterpretation "../StaticInter/CFGExit_wf" begin
inductive_set Def :: "wf_jvmprog ⇒ cfg_node ⇒ var set"
for P :: "wf_jvmprog"
and n :: "cfg_node"
where
Def_Main_Heap:
"n = (ClassMain P, MethodMain P, ⌊0⌋, Return)
⟹ Heap ∈ Def P n"
| Def_Main_Exception:
"n = (ClassMain P, MethodMain P, ⌊0⌋, Return)
⟹ Exception ∈ Def P n"
| Def_Main_Stack_0:
"n = (ClassMain P, MethodMain P, ⌊0⌋, Return)
⟹ Stack 0 ∈ Def P n"
| Def_Load:
"⟦ n = (C, M, ⌊pc⌋, Enter);
C ≠ ClassMain P;
instrs_of (PROG P) C M ! pc = Load idx;
i = stkLength (P, C, M) pc⟧
⟹ Stack i ∈ Def P n"
| Def_Store:
"⟦ n = (C, M, ⌊pc⌋, Enter);
C ≠ ClassMain P;
instrs_of (PROG P) C M ! pc = Store idx ⟧
⟹ Local idx ∈ Def P n"
| Def_Push:
"⟦ n = (C, M, ⌊pc⌋, Enter);
C ≠ ClassMain P;
instrs_of (PROG P) C M ! pc = Push v;
i = stkLength (P, C, M) pc ⟧
⟹ Stack i ∈ Def P n"
| Def_IAdd:
"⟦ n = (C, M, ⌊pc⌋, Enter);
C ≠ ClassMain P;
instrs_of (PROG P) C M ! pc = IAdd;
i = stkLength (P, C, M) pc - 2 ⟧
⟹ Stack i ∈ Def P n"
| Def_CmpEq:
"⟦ n = (C, M, ⌊pc⌋, Enter);
C ≠ ClassMain P;
instrs_of (PROG P) C M ! pc = CmpEq;
i = stkLength (P, C, M) pc - 2 ⟧
⟹ Stack i ∈ Def P n"
| Def_New_Heap:
"⟦ n = (C, M, ⌊pc⌋, Normal);
C ≠ ClassMain P;
instrs_of (PROG P) C M ! pc = New Cl ⟧
⟹ Heap ∈ Def P n"
| Def_New_Stack:
"⟦ n = (C, M, ⌊pc⌋, Normal);
C ≠ ClassMain P;
instrs_of (PROG P) C M ! pc = New Cl;
i = stkLength (P, C, M) pc ⟧
⟹ Stack i ∈ Def P n"
| Def_Exception:
"⟦ n = (C, M, ⌊pc⌋, Exceptional pco nt);
C ≠ ClassMain P ⟧
⟹ Exception ∈ Def P n"
| Def_Exception_handle:
"⟦ n = (C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter);
C ≠ ClassMain P;
i = stkLength (P, C, M) pc' - 1 ⟧
⟹ Stack i ∈ Def P n"
| Def_Exception_handle_return:
"⟦ n = (C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Return);
C ≠ ClassMain P;
i = stkLength (P, C, M) pc' - 1 ⟧
⟹ Stack i ∈ Def P n"
| Def_Getfield:
"⟦ n = (C, M, ⌊pc⌋, Normal);
C ≠ ClassMain P;
instrs_of (PROG P) C M ! pc = Getfield Cl Fd;
i = stkLength (P, C, M) pc - 1 ⟧
⟹ Stack i ∈ Def P n"
| Def_Putfield:
"⟦ n = (C, M, ⌊pc⌋, Normal);
C ≠ ClassMain P;
instrs_of (PROG P) C M ! pc = Putfield Cl Fd ⟧
⟹ Heap ∈ Def P n"
| Def_Invoke_Return_Heap:
"⟦ n = (C, M, ⌊pc⌋, Return);
C ≠ ClassMain P;
instrs_of (PROG P) C M ! pc = Invoke M' n' ⟧
⟹ Heap ∈ Def P n"
| Def_Invoke_Return_Exception:
"⟦ n = (C, M, ⌊pc⌋, Return);
C ≠ ClassMain P;
instrs_of (PROG P) C M ! pc = Invoke M' n' ⟧
⟹ Exception ∈ Def P n"
| Def_Invoke_Return_Stack:
"⟦ n = (C, M, ⌊pc⌋, Return);
C ≠ ClassMain P;
instrs_of (PROG P) C M ! pc = Invoke M' n';
i = stkLength (P, C, M) (Suc pc) - 1 ⟧
⟹ Stack i ∈ Def P n"
| Def_Invoke_Call_Heap:
"⟦ n = (C, M, None, Enter);
C ≠ ClassMain P ⟧
⟹ Heap ∈ Def P n"
| Def_Invoke_Call_Local:
"⟦ n = (C, M, None, Enter);
C ≠ ClassMain P;
i < locLength (P, C, M) 0 ⟧
⟹ Local i ∈ Def P n"
| Def_Return:
"⟦ n = (C, M, ⌊pc⌋, Enter);
C ≠ ClassMain P;
instrs_of (PROG P) C M ! pc = instr.Return ⟧
⟹ Stack 0 ∈ Def P n"
inductive_set Use :: "wf_jvmprog ⇒ cfg_node ⇒ var set"
for P :: "wf_jvmprog"
and n :: "cfg_node"
where
Use_Main_Heap:
"n = (ClassMain P, MethodMain P, ⌊0⌋, Normal)
⟹ Heap ∈ Use P n"
| Use_Load:
"⟦ n = (C, M, ⌊pc⌋, Enter);
C ≠ ClassMain P;
instrs_of (PROG P) C M ! pc = Load idx ⟧
⟹ Local idx ∈ Use P n"
| Use_Enter_Stack:
"⟦ n = (C, M, ⌊pc⌋, Enter);
C ≠ ClassMain P;
case (instrs_of (PROG P) C M ! pc)
of Store n' ⇒ d = 1
| Getfield F Cl ⇒ d = 1
| Putfield F Cl ⇒ d = 2
| Checkcast Cl ⇒ d = 1
| Invoke M' n' ⇒ d = Suc n'
| IAdd ⇒ d ∈ {1, 2}
| IfFalse i ⇒ d = 1
| CmpEq ⇒ d ∈ {1 , 2}
| Throw ⇒ d = 1
| instr.Return ⇒ d = 1
| _ ⇒ False;
i = stkLength (P, C, M) pc - d ⟧
⟹ Stack i ∈ Use P n"
| Use_Enter_Local:
"⟦ n = (C, M, ⌊pc⌋, Enter);
C ≠ ClassMain P;
instrs_of (PROG P) C M ! pc = Load n' ⟧
⟹ Local n' ∈ Use P n"
| Use_Enter_Heap:
"⟦ n = (C, M, ⌊pc⌋, Enter);
C ≠ ClassMain P;
case (instrs_of (PROG P) C M ! pc)
of New Cl ⇒ True
| Checkcast Cl ⇒ True
| Throw ⇒ True
| _ ⇒ False ⟧
⟹ Heap ∈ Use P n"
| Use_Normal_Heap:
"⟦ n = (C, M, ⌊pc⌋, Normal);
C ≠ ClassMain P;
case (instrs_of (PROG P) C M ! pc)
of New Cl ⇒ True
| Getfield F Cl ⇒ True
| Putfield F Cl ⇒ True
| Invoke M' n' ⇒ True
| _ ⇒ False ⟧
⟹ Heap ∈ Use P n"
| Use_Normal_Stack:
"⟦ n = (C, M, ⌊pc⌋, Normal);
C ≠ ClassMain P;
case (instrs_of (PROG P) C M ! pc)
of Getfield F Cl ⇒ d = 1
| Putfield F Cl ⇒ d ∈ {1, 2}
| Invoke M' n' ⇒ d > 0 ∧ d ≤ Suc n'
| _ ⇒ False;
i = stkLength (P, C, M) pc - d ⟧
⟹ Stack i ∈ Use P n"
| Use_Return_Heap:
"⟦ n = (C, M, ⌊pc⌋, Return);
instrs_of (PROG P) C M ! pc = Invoke M' n' ∨ C = ClassMain P ⟧
⟹ Heap ∈ Use P n"
| Use_Return_Stack:
"⟦ n = (C, M, ⌊pc⌋, Return);
(instrs_of (PROG P) C M ! pc = Invoke M' n' ∧ i = stkLength (P, C, M) (Suc pc) - 1) ∨
(C = ClassMain P ∧ i = 0) ⟧
⟹ Stack i ∈ Use P n"
| Use_Return_Exception:
"⟦ n = (C, M, ⌊pc⌋, Return);
instrs_of (PROG P) C M ! pc = Invoke M' n' ∨ C = ClassMain P ⟧
⟹ Exception ∈ Use P n"
| Use_Exceptional_Stack:
"⟦ n = (C, M, ⌊pc⌋, Exceptional opc' nt);
case (instrs_of (PROG P) C M ! pc)
of Throw ⇒ True
| _ ⇒ False;
i = stkLength (P, C, M) pc - 1 ⟧
⟹ Stack i ∈ Use P n"
| Use_Exceptional_Exception:
"⟦ n = (C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Return);
instrs_of (PROG P) C M ! pc = Invoke M' n' ⟧
⟹ Exception ∈ Use P n"
| Use_Method_Leave_Exception:
"⟦ n = (C, M, None, Return);
C ≠ ClassMain P ⟧
⟹ Exception ∈ Use P n"
| Use_Method_Leave_Heap:
"⟦ n = (C, M, None, Return);
C ≠ ClassMain P ⟧
⟹ Heap ∈ Use P n"
| Use_Method_Leave_Stack:
"⟦ n = (C, M, None, Return);
C ≠ ClassMain P ⟧
⟹ Stack 0 ∈ Use P n"
| Use_Method_Entry_Heap:
"⟦ n = (C, M, None, Enter);
C ≠ ClassMain P ⟧
⟹ Heap ∈ Use P n"
| Use_Method_Entry_Local:
"⟦ n = (C, M, None, Enter);
C ≠ ClassMain P;
i < locLength (P, C, M) 0 ⟧
⟹ Local i ∈ Use P n"
fun ParamDefs :: "wf_jvmprog ⇒ cfg_node ⇒ var list"
where
"ParamDefs P (C, M, ⌊pc⌋, Return) = [Heap, Stack (stkLength (P, C, M) (Suc pc) - 1), Exception]"
| "ParamDefs P (C, M, opc, nt) = []"
function ParamUses :: "wf_jvmprog ⇒ cfg_node ⇒ var set list"
where
"ParamUses P (ClassMain P, MethodMain P, ⌊0⌋, Normal) = [{Heap},{}]"
|
"M ≠ MethodMain P ∨ opc ≠ ⌊0⌋ ∨ nt ≠ Normal
⟹ ParamUses P (ClassMain P, M, opc, nt) = []"
|
"C ≠ ClassMain P
⟹ ParamUses P (C, M, opc, nt) = (case opc of None ⇒ []
| ⌊pc⌋ ⇒ (case nt of Normal ⇒ (case (instrs_of (PROG P) C M ! pc) of
Invoke M' n ⇒ (
{Heap} # rev (map (λn. {Stack (stkLength (P, C, M) pc - (Suc n))}) [0..<n + 1])
)
| _ ⇒ [])
| _ ⇒ []
)
)"
by atomize_elim auto
termination by lexicographic_order
lemma in_set_ParamDefsE:
"⟦ V ∈ set (ParamDefs P n);
⋀C M pc. ⟦ n = (C, M, ⌊pc⌋, Return);
V ∈ {Heap, Stack (stkLength (P, C, M) (Suc pc) - 1), Exception} ⟧ ⟹ thesis ⟧
⟹ thesis"
by (cases "(P, n)" rule: ParamDefs.cases) auto
lemma in_set_ParamUsesE:
assumes V_in_ParamUses: "V ∈ ⋃(set (ParamUses P n))"
obtains "n = (ClassMain P, MethodMain P, ⌊0⌋, Normal)" and "V = Heap"
| C M pc M' n' i where "n = (C, M, ⌊pc⌋, Normal)" and "instrs_of (PROG P) C M ! pc = Invoke M' n'"
and "V = Heap ∨ V = Stack (stkLength (P, C, M) pc - Suc i)" and "i < Suc n'" and "C ≠ ClassMain P"
proof (cases "(P, n)" rule: ParamUses.cases)
case 1 with V_in_ParamUses that show ?thesis by clarsimp
next
case 2 with V_in_ParamUses that show ?thesis by clarsimp
next
case (3 C P M pc nt)
with V_in_ParamUses that show ?thesis
using [[simproc del: list_to_set_comprehension]]
by (cases nt, auto) (rename_tac a b, case_tac "instrs_of (PROG P) C M ! a", simp_all, fastforce)
qed
lemma sees_method_fun_wf:
assumes "PROG P ⊢ D sees M': Ts→T = (mxs, mxl⇩0, is, xt) in D"
and "(D, D', fs, ms) ∈ set (PROG P)"
and "(M', Ts', T', mxs', mxl⇩0', is', xt') ∈ set ms"
shows "Ts = Ts' ∧ T = T' ∧ mxs = mxs' ∧ mxl⇩0 = mxl⇩0' ∧ is = is' ∧ xt = xt'"
proof -
from distinct_class_names [of P] ‹(D, D', fs, ms) ∈ set (PROG P)›
have "class (PROG P) D = ⌊(D', fs, ms)⌋"
by (fastforce intro: map_of_SomeI simp: class_def)
moreover with distinct_method_names have "distinct_fst ms"
by fastforce
ultimately show ?thesis using
‹PROG P ⊢ D sees M': Ts→T = (mxs, mxl⇩0, is, xt) in D›
‹(M', Ts', T', mxs', mxl⇩0', is', xt') ∈ set ms›
by (fastforce dest: visible_method_exists map_of_SomeD distinct_fst_isin_same_fst
simp: distinct_fst_is_distinct_fst)
qed
interpretation JVMCFG_wf:
CFG_wf "sourcenode" "targetnode" "kind" "valid_edge (P, C0, Main)"
"(ClassMain P, MethodMain P, None, Enter)"
"(λ(C, M, pc, type). (C, M))" "get_return_edges P"
"((ClassMain P, MethodMain P),[],[]) # procs (PROG P)"
"(ClassMain P, MethodMain P)"
"Def P" "Use P" "ParamDefs P" "ParamUses P"
for P C0 Main
proof (unfold_locales)
show "Def P (ClassMain P, MethodMain P, None, Enter) = {} ∧
Use P (ClassMain P, MethodMain P, None, Enter) = {}"
by (fastforce elim: Def.cases Use.cases)
next
fix a Q r p fs ins outs
assume "valid_edge (P, C0, Main) a"
and "kind a = Q:r↪⇘p⇙fs"
and params: "(p, ins, outs) ∈ set (((ClassMain P, MethodMain P), [], []) # procs (PROG P))"
hence "(P, C0, Main) ⊢ sourcenode a -Q:r↪⇘p⇙fs→ targetnode a"
by (simp add: valid_edge_def)
from this params show "length (ParamUses P (sourcenode a)) = length ins"
proof cases
case Main_Call
with params show ?thesis
by auto (erule in_set_procsE, auto dest: sees_method_idemp sees_method_fun)
next
case (CFG_Invoke_Call C M pc M' n ST LT D' Ts T mxs mxl0 "is" xt D Q' paramDefs)
hence [simp]: "Q' = Q" and [simp]: "r = (C, M, pc)" and [simp]: "p = (D, M')"
and [simp]: "fs = paramDefs"
by simp_all
from CFG_Invoke_Call obtain T' mxs' mpc' xt' where
"PROG P,T',mxs',mpc',xt' ⊢ instrs_of (PROG P) C M ! pc,pc :: TYPING P C M"
by (blast dest: reachable_node_impl_wt_instr)
moreover from ‹PROG P ⊢ D' sees M': Ts→T = (mxs, mxl0, is, xt) in D›
have "PROG P ⊢ D sees M': Ts→T = (mxs, mxl0, is, xt) in D"
by -(drule sees_method_idemp)
with params have "PROG P ⊢ D sees M': Ts→T=(mxs, mxl0, is, xt) in D"
and "ins = Heap # map Local [0..<Suc (length Ts)]"
by (fastforce elim: in_set_procsE dest: sees_method_fun)+
ultimately show ?thesis using CFG_Invoke_Call
by (fastforce dest: sees_method_fun list_all2_lengthD simp: min_def)
qed simp_all
next
fix a
assume "valid_edge (P, C0, Main) a"
thus "distinct (ParamDefs P (targetnode a))"
by (clarsimp simp: valid_edge_def) (erule JVMCFG.cases, auto)
next
fix a Q' p f' ins outs
assume "valid_edge (P, C0, Main) a"
and "kind a = Q'↩⇘p⇙f'"
and params: "(p, ins, outs) ∈ set (((ClassMain P, MethodMain P), [], []) # procs (PROG P))"
hence "(P, C0, Main) ⊢ sourcenode a -Q'↩⇘p⇙f'→ targetnode a"
by (simp add: valid_edge_def)
from this params
show "length (ParamDefs P (targetnode a)) = length outs"
by cases (auto elim: in_set_procsE)
next
fix n V
assume params: "V ∈ set (ParamDefs P n)"
and vn: "CFG.valid_node sourcenode targetnode (valid_edge (P, C0, Main)) n"
then obtain ek n'
where ve:"valid_edge (P, C0, Main) (n, ek, n') ∨ valid_edge (P, C0, Main) (n', ek, n)"
by (fastforce simp: JVMCFG_Interpret.valid_node_def)
from params obtain C M pc where [simp]: "n = (C, M, ⌊pc⌋, Return)"
and V: "V ∈ {Heap, Stack (stkLength (P, C, M) (Suc pc) - 1), Exception}"
by (blast elim: in_set_ParamDefsE)
from ve show "V ∈ Def P n"
proof
assume "valid_edge (P, C0, Main) (n, ek, n')"
thus ?thesis unfolding valid_edge_def
proof cases
case Main_Return_to_Exit with V show ?thesis
by (auto intro: Def_Main_Heap Def_Main_Stack_0 Def_Main_Exception simp: stkLength_def)
next
case CFG_Invoke_Return_Check_Normal with V show ?thesis
by (fastforce intro: Def_Invoke_Return_Heap
Def_Invoke_Return_Stack Def_Invoke_Return_Exception)
next
case CFG_Invoke_Return_Check_Exceptional with V show ?thesis
by (fastforce intro: Def_Invoke_Return_Heap
Def_Invoke_Return_Stack Def_Invoke_Return_Exception)
next
case CFG_Invoke_Return_Exceptional_prop with V show ?thesis
by (fastforce intro: Def_Invoke_Return_Heap
Def_Invoke_Return_Stack Def_Invoke_Return_Exception)
qed simp_all
next
assume "valid_edge (P, C0, Main) (n', ek, n)"
thus ?thesis unfolding valid_edge_def
proof cases
case Main_Call_LFalse with V show ?thesis
by (auto intro: Def_Main_Heap Def_Main_Stack_0 Def_Main_Exception simp: stkLength_def)
next
case CFG_Invoke_False with V show ?thesis
by (fastforce intro: Def_Invoke_Return_Heap
Def_Invoke_Return_Stack Def_Invoke_Return_Exception)
next
case CFG_Return_from_Method with V show ?thesis
by (fastforce elim!: JVMCFG.cases intro!: Def_Main_Stack_0
intro: Def_Main_Heap Def_Main_Exception Def_Invoke_Return_Heap
Def_Invoke_Return_Exception Def_Invoke_Return_Stack simp: stkLength_def)
qed simp_all
qed
next
fix a Q r p fs ins outs V
assume ve: "valid_edge (P, C0, Main) a"
and kind: "kind a = Q:r↪⇘p⇙fs"
and params: "(p, ins, outs) ∈ set (((ClassMain P, MethodMain P), [], []) # procs (PROG P))"
and V: "V ∈ set ins"
from params V obtain D fs ms Ts T mb where "class (PROG P) (fst p) = ⌊(D, fs, ms)⌋"
and "method": "PROG P ⊢ (fst p) sees (snd p): Ts→T = mb in (fst p)"
and ins: "ins = Heap # map Local [0..<Suc (length Ts)]"
by (cases p) (fastforce elim: in_set_procsE)
from ve kind show "V ∈ Def P (targetnode a)" unfolding valid_edge_def
proof cases
case (Main_Call T' mxs mxl0 "is" xt D' initParams)
with kind have "PROG P ⊢ D' sees Main: []→T' = (mxs, mxl0, is, xt) in D'"
and [simp]: "p = (D', Main)"
by (auto dest: sees_method_idemp)
with "method" have [simp]: "Ts = []" and [simp]: "T' = T" and [simp]: "mb = (mxs, mxl0, is, xt)"
by (fastforce dest: sees_method_fun)+
from Main_Call ins V show ?thesis
by (fastforce intro!: Def_Invoke_Call_Heap Def_Invoke_Call_Local
dest: sees_method_idemp wt_jvm_prog_impl_wt_start[OF wf_jvmprog_is_wf_typ]
simp: locLength_def wt_start_def)
next
case (CFG_Invoke_Call C M pc M' n ST LT D' Ts' T' mxs mxl0 "is" xt D'')
with kind have "PROG P ⊢ D'' sees M': Ts'→T' = (mxs, mxl0, is, xt) in D''"
and [simp]: "p = (D'', M')"
by (auto dest: sees_method_idemp)
with "method" have [simp]: "Ts' = Ts" and [simp]: "T' = T" and [simp]: "mb = (mxs, mxl0, is, xt)"
by (fastforce dest: sees_method_fun)+
from CFG_Invoke_Call ins V show ?thesis
by (fastforce intro!: Def_Invoke_Call_Local Def_Invoke_Call_Heap
dest: sees_method_idemp wt_jvm_prog_impl_wt_start[OF wf_jvmprog_is_wf_typ] list_all2_lengthD
simp: locLength_def min_def wt_start_def)
qed simp_all
next
fix a Q r p fs
assume "valid_edge (P, C0, Main) a" and "kind a = Q:r↪⇘p⇙fs"
thus "Def P (sourcenode a) = {}" unfolding valid_edge_def
by cases (auto elim: Def.cases)
next
fix n V
assume "CFG.valid_node sourcenode targetnode (valid_edge (P, C0, Main)) n"
and V: "V ∈ ⋃(set (ParamUses P n))"
then obtain ek n'
where ve:"valid_edge (P, C0, Main) (n, ek, n') ∨ valid_edge (P, C0, Main) (n', ek, n)"
by (fastforce simp: JVMCFG_Interpret.valid_node_def)
from V obtain C M pc M' n'' i where
V: "n = (ClassMain P, MethodMain P, ⌊0⌋, Normal) ∧ V = Heap ∨
n = (C, M, ⌊pc⌋, Normal) ∧ instrs_of (PROG P) C M ! pc = Invoke M' n'' ∧
(V = Heap ∨ V = Stack (stkLength (P, C, M) pc - Suc i)) ∧ i < Suc n'' ∧ C ≠ ClassMain P"
by -(erule in_set_ParamUsesE, fastforce+)
from ve show "V ∈ Use P n"
proof
assume "valid_edge (P, C0, Main) (n, ek, n')"
from this V show ?thesis unfolding valid_edge_def
proof cases
case Main_Call_LFalse with V show ?thesis by (fastforce intro: Use_Main_Heap)
next
case Main_Call with V show ?thesis by (fastforce intro: Use_Main_Heap)
next
case CFG_Invoke_Call with V show ?thesis
by (fastforce intro: Use_Normal_Heap Use_Normal_Stack [where d="Suc i"])
next
case CFG_Invoke_False with V show ?thesis
by (fastforce intro: Use_Normal_Heap Use_Normal_Stack [where d="Suc i"])
qed simp_all
next
assume "valid_edge (P, C0, Main) (n', ek, n)"
from this V show ?thesis unfolding valid_edge_def
proof cases
case Main_to_Call with V show ?thesis by (fastforce intro: Use_Main_Heap)
next
case CFG_Invoke_Check_NP_Normal with V show ?thesis
by (fastforce intro: Use_Normal_Heap Use_Normal_Stack [where d="Suc i"])
qed simp_all
qed
next
fix a Q p f ins outs V
assume "valid_edge (P, C0, Main) a"
and "kind a = Q↩⇘p⇙f"
and "(p, ins, outs) ∈ set (((ClassMain P, MethodMain P), [], []) # procs (PROG P))"
and "V ∈ set outs"
thus "V ∈ Use P (sourcenode a)" unfolding valid_edge_def
by (cases, simp_all)
(fastforce elim: in_set_procsE
intro: Use_Method_Leave_Heap Use_Method_Leave_Stack Use_Method_Leave_Exception)
next
fix a V s
assume ve: "valid_edge (P, C0, Main) a"
and V_notin_Def: "V ∉ Def P (sourcenode a)"
and ik: "intra_kind (kind a)"
and pred: "JVMCFG_Interpret.pred (kind a) s"
show "JVMCFG_Interpret.state_val
(CFG.transfer (((ClassMain P, MethodMain P), [], []) # procs (PROG P)) (kind a) s) V
= JVMCFG_Interpret.state_val s V"
proof (cases s)
case Nil
thus ?thesis by simp
next
case [simp]: Cons
with ve V_notin_Def ik pred show ?thesis unfolding valid_edge_def
proof cases
case CFG_Load with V_notin_Def show ?thesis by (fastforce intro: Def_Load)
next case CFG_Store with V_notin_Def show ?thesis by (fastforce intro: Def_Store)
next case CFG_Push with V_notin_Def show ?thesis by (fastforce intro: Def_Push)
next case CFG_IAdd with V_notin_Def show ?thesis by (fastforce intro: Def_IAdd)
next case CFG_CmpEq with V_notin_Def show ?thesis by (fastforce intro: Def_CmpEq)
next case CFG_New_Update with V_notin_Def show ?thesis
by (fastforce intro: Def_New_Heap Def_New_Stack)
next case CFG_New_Exceptional_prop with V_notin_Def show ?thesis
by (fastforce intro: Def_Exception)
next case CFG_New_Exceptional_handle with V_notin_Def show ?thesis
by (fastforce intro: Def_Exception Def_Exception_handle)
next case CFG_Getfield_Update with V_notin_Def show ?thesis
by (fastforce intro: Def_Getfield split: prod.split)
next case CFG_Getfield_Exceptional_prop with V_notin_Def show ?thesis
by (fastforce intro: Def_Exception)
next case CFG_Getfield_Exceptional_handle with V_notin_Def show ?thesis
by (fastforce intro: Def_Exception Def_Exception_handle)
next case CFG_Putfield_Update with V_notin_Def show ?thesis
by (fastforce intro: Def_Putfield split: prod.split)
next case CFG_Putfield_Exceptional_prop with V_notin_Def show ?thesis
by (fastforce intro: Def_Exception)
next case CFG_Putfield_Exceptional_handle with V_notin_Def show ?thesis
by (fastforce intro: Def_Exception Def_Exception_handle)
next case CFG_Checkcast_Exceptional_prop with V_notin_Def show ?thesis
by (fastforce intro: Def_Exception)
next case CFG_Checkcast_Exceptional_handle with V_notin_Def show ?thesis
by (fastforce intro: Def_Exception Def_Exception_handle)
next case CFG_Throw_prop with V_notin_Def show ?thesis by (fastforce intro: Def_Exception)
next case CFG_Throw_handle with V_notin_Def show ?thesis
by (fastforce intro: Def_Exception Def_Exception_handle)
next case CFG_Invoke_NP_prop with V_notin_Def show ?thesis by (fastforce intro: Def_Exception)
next case CFG_Invoke_NP_handle with V_notin_Def show ?thesis
by (fastforce intro: Def_Exception Def_Exception_handle)
next case CFG_Invoke_Return_Exceptional_handle with V_notin_Def show ?thesis
by (fastforce intro: Def_Exception_handle_return Def_Exception)
next case CFG_Return with V_notin_Def show ?thesis by (fastforce intro: Def_Return)
qed (simp_all add: intra_kind_def)
qed
next
fix a s s'
assume ve: "valid_edge (P, C0, Main) a"
and use_Eq: "∀V∈Use P (sourcenode a). JVMCFG_Interpret.state_val s V
= JVMCFG_Interpret.state_val s' V"
and ik: "intra_kind (kind a)"
and pred_s: "JVMCFG_Interpret.pred (kind a) s"
and pred_s': "JVMCFG_Interpret.pred (kind a) s'"
then obtain cfs C M pc cs cfs' C' M' pc' cs' where [simp]: "s = (cfs, (C, M, pc)) # cs"
and [simp]: "s' = (cfs', (C', M', pc')) # cs'"
by (cases s, fastforce) (cases s', fastforce+)
from ve show "∀V∈Def P (sourcenode a).
JVMCFG_Interpret.state_val
(CFG.transfer (((ClassMain P, MethodMain P), [], []) # procs (PROG P)) (kind a) s) V =
JVMCFG_Interpret.state_val
(CFG.transfer (((ClassMain P, MethodMain P), [], []) # procs (PROG P)) (kind a) s') V"
unfolding valid_edge_def
proof cases
case Main_Call with ik show ?thesis by (simp add: intra_kind_def)
next case Main_Return_to_Exit with use_Eq show ?thesis
by (fastforce elim: Def.cases intro: Use_Return_Heap Use_Return_Exception Use_Return_Stack)
next case Method_LFalse with use_Eq show ?thesis
by (fastforce elim: Def.cases intro: Use_Method_Entry_Heap Use_Method_Entry_Local)
next case Method_LTrue with use_Eq show ?thesis
by (fastforce elim: Def.cases intro: Use_Method_Entry_Heap Use_Method_Entry_Local)
next case CFG_Load with use_Eq show ?thesis
by (fastforce elim: Def.cases intro: Use_Enter_Local)
next case CFG_Store with use_Eq show ?thesis
by (fastforce elim: Def.cases intro: Use_Enter_Stack)
next case (CFG_IAdd C M pc)
hence "Stack (stkLength (P, C, M) pc - 1) ∈ Use P (sourcenode a)"
and "Stack (stkLength (P, C, M) pc - 2) ∈ Use P (sourcenode a)"
by (fastforce intro: Use_Enter_Stack)+
with use_Eq CFG_IAdd show ?thesis by (auto elim!: Def.cases)
next case (CFG_CmpEq C M pc)
hence "Stack (stkLength (P, C, M) pc - 1) ∈ Use P (sourcenode a)"
and "Stack (stkLength (P, C, M) pc - 2) ∈ Use P (sourcenode a)"
by (fastforce intro: Use_Enter_Stack)+
with use_Eq CFG_CmpEq show ?thesis by (auto elim!: Def.cases)
next case CFG_New_Update
hence "Heap ∈ Use P (sourcenode a)" by (fastforce intro: Use_Normal_Heap)
with use_Eq CFG_New_Update show ?thesis by (fastforce elim: Def.cases)
next case (CFG_Getfield_Update C M pc)
hence "Heap ∈ Use P (sourcenode a)"
and "Stack (stkLength (P, C, M) pc - 1) ∈ Use P (sourcenode a)"
by (fastforce intro: Use_Normal_Heap Use_Normal_Stack)+
with use_Eq CFG_Getfield_Update show ?thesis by (auto elim!: Def.cases split: prod.split)
next case (CFG_Putfield_Update C M pc)
hence "Heap ∈ Use P (sourcenode a)"
and "Stack (stkLength (P, C, M) pc - 1) ∈ Use P (sourcenode a)"
and "Stack (stkLength (P, C, M) pc - 2) ∈ Use P (sourcenode a)"
by (fastforce intro: Use_Normal_Heap Use_Normal_Stack)+
with use_Eq CFG_Putfield_Update show ?thesis by (auto elim!: Def.cases split: prod.split)
next case (CFG_Throw_prop C M pc)
hence "Stack (stkLength (P, C, M) pc - 1) ∈ Use P (sourcenode a)"
by (fastforce intro: Use_Exceptional_Stack)
with use_Eq CFG_Throw_prop show ?thesis by (fastforce elim: Def.cases)
next case (CFG_Throw_handle C M pc)
hence "Stack (stkLength (P, C, M) pc - 1) ∈ Use P (sourcenode a)"
by (fastforce intro: Use_Exceptional_Stack)
with use_Eq CFG_Throw_handle show ?thesis by (fastforce elim: Def.cases)
next case CFG_Invoke_Call with ik show ?thesis by (simp add: intra_kind_def)
next case CFG_Invoke_Return_Check_Normal with use_Eq show ?thesis
by (fastforce elim: Def.cases intro: Use_Return_Heap Use_Return_Exception Use_Return_Stack)
next case CFG_Invoke_Return_Check_Exceptional with use_Eq show ?thesis
by (fastforce elim: Def.cases intro: Use_Return_Heap Use_Return_Exception Use_Return_Stack)
next case CFG_Invoke_Return_Exceptional_handle with use_Eq show ?thesis
by (fastforce elim: Def.cases intro: Use_Exceptional_Exception)
next case CFG_Invoke_Return_Exceptional_prop with use_Eq show ?thesis
by (fastforce elim: Def.cases intro: Use_Return_Heap Use_Return_Exception Use_Return_Stack)
next case CFG_Return with use_Eq show ?thesis
by (fastforce elim!: Def.cases intro: Use_Enter_Stack)
next case CFG_Return_from_Method with ik show ?thesis by (simp add: intra_kind_def)
qed (fastforce elim: Def.cases)+
next
fix a s s'
assume ve: "valid_edge (P, C0, Main) a"
and pred: "JVMCFG_Interpret.pred (kind a) s"
and "snd (hd s) = snd (hd s')"
and use_Eq: "∀V∈Use P (sourcenode a).
JVMCFG_Interpret.state_val s V = JVMCFG_Interpret.state_val s' V"
and "length s = length s'"
then obtain cfs C M pc cs cfs' cs' where [simp]: "s = (cfs, (C, M, pc)) # cs"
and [simp]: "s' = (cfs', (C, M, pc)) # cs'" and length_cs: "length cs = length cs'"
by (cases s, fastforce) (cases s', fastforce+)
from ve pred show "JVMCFG_Interpret.pred (kind a) s'"
unfolding valid_edge_def
proof cases
case Main_Call_LFalse with pred show ?thesis by simp
next case Main_Call with pred use_Eq show ?thesis by simp
next case Method_LTrue with pred use_Eq show ?thesis by simp
next case CFG_Goto with pred use_Eq show ?thesis by simp
next case (CFG_IfFalse_False C M pc)
hence "Stack (stkLength (P, C, M) pc - 1) ∈ Use P (sourcenode a)"
by (fastforce intro: Use_Enter_Stack)
with use_Eq CFG_IfFalse_False pred show ?thesis by fastforce
next case (CFG_IfFalse_True C M pc)
hence "Stack (stkLength (P, C, M) pc - 1) ∈ Use P (sourcenode a)"
by (fastforce intro: Use_Enter_Stack)
with pred use_Eq CFG_IfFalse_True show ?thesis by fastforce
next case CFG_New_Check_Normal
hence "Heap ∈ Use P (sourcenode a)"
by (fastforce intro: Use_Enter_Heap)
with pred use_Eq CFG_New_Check_Normal show ?thesis by fastforce
next case CFG_New_Check_Exceptional
hence "Heap ∈ Use P (sourcenode a)"
by (fastforce intro: Use_Enter_Heap)
with pred use_Eq CFG_New_Check_Exceptional show ?thesis by fastforce
next case (CFG_Getfield_Check_Normal C M pc)
hence "Stack (stkLength (P, C, M) pc - 1) ∈ Use P (sourcenode a)"
by (fastforce intro: Use_Enter_Stack)
with pred use_Eq CFG_Getfield_Check_Normal show ?thesis by fastforce
next case (CFG_Getfield_Check_Exceptional C M pc)
hence "Stack (stkLength (P, C, M) pc - 1) ∈ Use P (sourcenode a)"
by (fastforce intro: Use_Enter_Stack)
with pred use_Eq CFG_Getfield_Check_Exceptional show ?thesis by fastforce
next case (CFG_Putfield_Check_Normal C M pc)
hence "Stack (stkLength (P, C, M) pc - 2) ∈ Use P (sourcenode a)"
by (fastforce intro: Use_Enter_Stack)
with pred use_Eq CFG_Putfield_Check_Normal show ?thesis by fastforce
next case (CFG_Putfield_Check_Exceptional C M pc)
hence "Stack (stkLength (P, C, M) pc - 2) ∈ Use P (sourcenode a)"
by (fastforce intro: Use_Enter_Stack)
with pred use_Eq CFG_Putfield_Check_Exceptional show ?thesis by fastforce
next case (CFG_Checkcast_Check_Normal C M pc)
hence "Stack (stkLength (P, C, M) pc - 1) ∈ Use P (sourcenode a)"
and "Heap ∈ Use P (sourcenode a)"
by (fastforce intro: Use_Enter_Stack Use_Enter_Heap)+
with pred use_Eq CFG_Checkcast_Check_Normal show ?thesis by fastforce
next case (CFG_Checkcast_Check_Exceptional C M pc)
hence "Stack (stkLength (P, C, M) pc - 1) ∈ Use P (sourcenode a)"
and "Heap ∈ Use P (sourcenode a)"
by (fastforce intro: Use_Enter_Stack Use_Enter_Heap)+
with pred use_Eq CFG_Checkcast_Check_Exceptional show ?thesis by fastforce
next case (CFG_Throw_Check C M pc)
hence "Stack (stkLength (P, C, M) pc - 1) ∈ Use P (sourcenode a)"
and "Heap ∈ Use P (sourcenode a)"
by (fastforce intro: Use_Enter_Stack Use_Enter_Heap)+
with pred use_Eq CFG_Throw_Check show ?thesis by fastforce
next case (CFG_Invoke_Check_NP_Normal C M pc M' n)
hence "Stack (stkLength (P, C, M) pc - (Suc n)) ∈ Use P (sourcenode a)"
by (fastforce intro: Use_Enter_Stack)
with pred use_Eq CFG_Invoke_Check_NP_Normal show ?thesis by fastforce
next case (CFG_Invoke_Check_NP_Exceptional C M pc M' n)
hence "Stack (stkLength (P, C, M) pc - (Suc n)) ∈ Use P (sourcenode a)"
by (fastforce intro: Use_Enter_Stack)
with pred use_Eq CFG_Invoke_Check_NP_Exceptional show ?thesis by fastforce
next case (CFG_Invoke_Call C M pc M' n)
hence "Stack (stkLength (P, C, M) pc - (Suc n)) ∈ Use P (sourcenode a)"
and "Heap ∈ Use P (sourcenode a)"
by (fastforce intro: Use_Normal_Heap Use_Normal_Stack)+
with pred use_Eq CFG_Invoke_Call show ?thesis by fastforce
next case CFG_Invoke_Return_Check_Normal
hence "Exception ∈ Use P (sourcenode a)"
by (fastforce intro: Use_Return_Exception)
with pred use_Eq CFG_Invoke_Return_Check_Normal show ?thesis by fastforce
next case CFG_Invoke_Return_Check_Exceptional
hence "Exception ∈ Use P (sourcenode a)" and "Heap ∈ Use P (sourcenode a)"
by (fastforce intro: Use_Return_Exception Use_Return_Heap)+
with pred use_Eq CFG_Invoke_Return_Check_Exceptional show ?thesis by fastforce
next case CFG_Invoke_Return_Exceptional_prop
hence "Exception ∈ Use P (sourcenode a)" and "Heap ∈ Use P (sourcenode a)"
by (fastforce intro: Use_Return_Exception Use_Return_Heap)+
with pred use_Eq CFG_Invoke_Return_Exceptional_prop show ?thesis by fastforce
next case CFG_Return_from_Method with pred length_cs show ?thesis by clarsimp
qed auto
next
fix a Q r p fs ins outs
assume "valid_edge (P, C0, Main) a"
and kind: "kind a = Q:r↪⇘p⇙fs"
and params: "(p, ins, outs) ∈ set (((ClassMain P, MethodMain P), [], []) # procs (PROG P))"
thus "length fs = length ins" unfolding valid_edge_def
proof cases
case (Main_Call T mxs mxl0 "is" xt D)
with kind params have [simp]: "p = (D, Main)"
and "PROG P ⊢ D sees Main: []→T = (mxs, mxl0, is, xt) in D"
and "ins = Heap # map Local [0..<Suc 0]"
by (auto elim!: in_set_procsE dest: sees_method_fun sees_method_idemp)
with Main_Call kind show ?thesis
by auto
next
case (CFG_Invoke_Call C M pc M' n ST LT D' Ts T mxs mxl0 "is" xt D)
with kind params have [simp]: "p = (D, M')"
and "PROG P ⊢ D' sees M': Ts→T = (mxs, mxl0, is, xt) in D"
and "ins = Heap # map Local [0..<Suc (length Ts)]"
by (auto elim!: in_set_procsE dest: sees_method_fun sees_method_idemp)
moreover with ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Normal)› ‹C ≠ ClassMain P›
‹instrs_of (PROG P) C M ! pc = Invoke M' n› ‹TYPING P C M ! pc = ⌊(ST, LT)⌋›
‹ST ! n = Class D'› have "n = length Ts"
by (fastforce dest!: reachable_node_impl_wt_instr dest: sees_method_fun list_all2_lengthD)
ultimately show ?thesis using CFG_Invoke_Call kind by auto
qed simp_all
next
fix a Q r p fs a' Q' r' p' fs' s s'
assume ve_a: "valid_edge (P, C0, Main) a"
and kind_a: "kind a = Q:r↪⇘p⇙fs"
and ve_a': "valid_edge (P, C0, Main) a'"
and kind_a': "kind a' = Q':r'↪⇘p'⇙fs'"
and src: "sourcenode a = sourcenode a'"
and pred_s: "JVMCFG_Interpret.pred (kind a) s"
and pred_s': "JVMCFG_Interpret.pred (kind a') s"
then obtain cfs C M pc cs cfs' C' M' pc' cs'
where [simp]: "s = (cfs, (C, M, pc)) # cs"
by (cases s) fastforce+
with ve_a kind_a show "a = a'" unfolding valid_edge_def
proof cases
case Main_Call with ve_a' kind_a' src pred_s pred_s' show ?thesis unfolding valid_edge_def
by (cases a, cases a') (fastforce elim: JVMCFG.cases dest: sees_method_fun)
next
case CFG_Invoke_Call
note invoke_call1 = this
from ve_a' kind_a' show ?thesis unfolding valid_edge_def
proof cases
case Main_Call with CFG_Invoke_Call src have False by simp
thus ?thesis by simp
next
case CFG_Invoke_Call with src invoke_call1 show ?thesis
by clarsimp (cases a, cases a', fastforce dest: sees_method_fun)
qed simp_all
qed simp_all
next
fix a Q r p fs i ins outs s s'
assume ve: "valid_edge (P, C0, Main) a"
and kind: "kind a = Q:r↪⇘p⇙fs"
and "i < length ins"
and "(p, ins, outs) ∈ set (((ClassMain P, MethodMain P), [], []) # procs (PROG P))"
and "JVMCFG_Interpret.pred (kind a) s"
and "JVMCFG_Interpret.pred (kind a) s'"
and use_Eq: "∀V∈ParamUses P (sourcenode a) ! i.
JVMCFG_Interpret.state_val s V = JVMCFG_Interpret.state_val s' V"
then obtain cfs C M pc cs cfs' C' M' pc' cs' where [simp]: "s = (cfs, (C, M, pc)) # cs"
and [simp]: "s' = (cfs', (C', M', pc')) # cs'"
by (cases s, fastforce) (cases s', fastforce+)
from ve kind
show "JVMCFG_Interpret.params fs (JVMCFG_Interpret.state_val s) ! i =
JVMCFG_Interpret.params fs (JVMCFG_Interpret.state_val s') ! i"
unfolding valid_edge_def
proof cases
case Main_Call with kind use_Eq ‹i < length ins› show ?thesis
by (cases i) auto
next
case CFG_Invoke_Call
{ fix P C M pc n st st' i
have "∀V∈rev (map (λn. {Stack (stkLength (P, C, M) pc - Suc n)}) [0..<n]) ! i. st V = st' V
⟹ JVMCFG_Interpret.params
(rev (map (λi s. s (Stack (stkLength (P, C, M) pc - Suc i))) [0..<n])) st ! i =
JVMCFG_Interpret.params
(rev (map (λi s. s (Stack (stkLength (P, C, M) pc - Suc i))) [0..<n])) st' ! i"
by (induct n arbitrary: i) (simp, case_tac i, auto)
}
note stack_params = this
from CFG_Invoke_Call kind use_Eq ‹i < length ins› show ?thesis
by (cases i, auto) (case_tac nat, auto intro: stack_params)
qed simp_all
next
fix a Q' p f' ins outs vmap vmap'
assume "valid_edge (P, C0, Main) a"
and "kind a = Q'↩⇘p⇙f'"
and "(p, ins, outs) ∈ set (((ClassMain P, MethodMain P), [], []) # procs (PROG P))"
thus "f' vmap vmap' = vmap'(ParamDefs P (targetnode a) [:=] map vmap outs)"
unfolding valid_edge_def
by (cases, simp_all) (fastforce elim: in_set_procsE simp: fun_upd_twist)
next
fix a a'
{ fix P n f n' e n''
assume "P ⊢ n -⇑f→ n'" and "P ⊢ n -e→ n''"
hence "e = ⇑f ∧ n' = n''"
by cases (simp_all, (fastforce elim: JVMCFG.cases)+)
}
note upd_det = this
{ fix P n Q n' Q' n'' s
assume "P ⊢ n -(Q)⇩√→ n'" and edge': "P ⊢ n -(Q')⇩√→ n''" and trg: "n' ≠ n''"
hence "(Q s ⟶ ¬ Q' s) ∧ (Q' s ⟶ ¬ Q s)"
proof cases
case CFG_Throw_Check with edge' trg show ?thesis by cases fastforce+
qed (simp_all, (fastforce elim: JVMCFG.cases)+)
}
note pred_det = this
assume "valid_edge (P, C0, Main) a"
and ve': "valid_edge (P, C0, Main) a'"
and src: "sourcenode a = sourcenode a'"
and trg: "targetnode a ≠ targetnode a'"
and "intra_kind (kind a)"
and "intra_kind (kind a')"
thus "∃Q Q'. kind a = (Q)⇩√ ∧ kind a' = (Q')⇩√ ∧ (∀s. (Q s ⟶ ¬ Q' s) ∧ (Q' s ⟶ ¬ Q s))"
unfolding valid_edge_def intra_kind_def
by (auto dest: upd_det pred_det)
qed
interpretation JVMCFGExit_wf :
CFGExit_wf "sourcenode" "targetnode" "kind" "valid_edge (P, C0, Main)"
"(ClassMain P, MethodMain P, None, Enter)"
"(λ(C, M, pc, type). (C, M))" "get_return_edges P"
"((ClassMain P, MethodMain P),[],[]) # procs (PROG P)"
"(ClassMain P, MethodMain P)"
"(ClassMain P, MethodMain P, None, Return)"
"Def P" "Use P" "ParamDefs P" "ParamUses P"
proof
show "Def P (ClassMain P, MethodMain P, None, nodeType.Return) = {} ∧
Use P (ClassMain P, MethodMain P, None, nodeType.Return) = {}"
by (fastforce elim: Def.cases Use.cases)
qed
end
Theory JVMPostdomination
theory JVMPostdomination imports JVMInterpretation "../StaticInter/Postdomination" begin
context CFG begin
lemma vp_snocI:
"⟦n -as→⇩√* n'; n' -[a]→* n''; ∀Q p ret fs. kind a ≠ Q↩⇘p⇙ret ⟧ ⟹ n -as @ [a]→⇩√* n''"
by (cases "kind a") (auto intro: path_Append valid_path_aux_Append simp: vp_def valid_path_def)
lemma valid_node_cases' [case_names Source Target, consumes 1]:
"⟦ valid_node n; ⋀e. ⟦ valid_edge e; sourcenode e = n ⟧ ⟹ thesis;
⋀e. ⟦ valid_edge e; targetnode e = n ⟧ ⟹ thesis ⟧
⟹ thesis"
by (auto simp: valid_node_def)
end
lemma disjE_strong: "⟦P ∨ Q; P ⟹ R; ⟦Q; ¬ P⟧ ⟹ R⟧ ⟹ R"
by auto
lemmas path_intros [intro] = JVMCFG_Interpret.path.Cons_path JVMCFG_Interpret.path.empty_path
declare JVMCFG_Interpret.vp_snocI [intro]
declare JVMCFG_Interpret.valid_node_def [simp add]
valid_edge_def [simp add]
JVMCFG_Interpret.intra_path_def [simp add]
abbreviation vp_snoc :: "wf_jvmprog ⇒ cname ⇒ mname ⇒ cfg_edge list ⇒ cfg_node
⇒ (var, val, cname × mname × pc, cname × mname) edge_kind ⇒ cfg_node ⇒ bool"
where "vp_snoc P C0 Main as n ek n'
≡ JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) (as @ [(n,ek,n')]) n'"
lemma
"(P, C0, Main) ⊢ (C, M, pc, nt) -ek→ (C', M', pc', nt')
⟹ (∃as. CFG.valid_path' sourcenode targetnode kind (valid_edge (P, C0, Main))
(get_return_edges P) (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, nt)) ∧
(∃as. CFG.valid_path' sourcenode targetnode kind (valid_edge (P, C0, Main))
(get_return_edges P) (ClassMain P, MethodMain P, None, Enter) as (C', M', pc', nt'))"
and valid_Entry_path: "(P, C0, Main) ⊢ ⇒(C, M, pc, nt)
⟹ ∃as. CFG.valid_path' sourcenode targetnode kind (valid_edge (P, C0, Main))
(get_return_edges P) (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, nt)"
proof (induct rule: JVMCFG_reachable_inducts)
case (Entry_reachable P C0 Main)
hence "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) [] (ClassMain P, MethodMain P, None, Enter)"
by (fastforce intro: JVMCFG_Interpret.intra_path_vp Method_LTrue
JVMCFG_reachable.Entry_reachable)
thus ?case by blast
next
case (reachable_step P C0 Main C M pc nt ek C' M' pc' nt')
thus ?case by simp
next
case (Main_to_Call P C0 Main)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (ClassMain P, MethodMain P, ⌊0⌋, Enter)"
by blast
moreover with ‹(P, C0, Main) ⊢ ⇒(ClassMain P, MethodMain P, ⌊0⌋, Enter)›
have "vp_snoc P C0 Main as (ClassMain P, MethodMain P, ⌊0⌋, Enter) ⇑id
(ClassMain P, MethodMain P, ⌊0⌋, Normal)"
by (fastforce intro: JVMCFG_reachable.Main_to_Call)
ultimately show ?case by blast
next
case (Main_Call_LFalse P C0 Main)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (ClassMain P, MethodMain P, ⌊0⌋, Normal)"
by blast
moreover with ‹(P, C0, Main) ⊢ ⇒(ClassMain P, MethodMain P, ⌊0⌋, Normal)›
have "vp_snoc P C0 Main as (ClassMain P, MethodMain P, ⌊0⌋, Normal) (λs. False)⇩√
(ClassMain P, MethodMain P, ⌊0⌋, Return)"
by (fastforce intro: JVMCFG_reachable.Main_Call_LFalse)
ultimately show ?case by blast
next
case (Main_Call P C0 Main T mxs mxl⇩0 "is" xt D initParams ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (ClassMain P, MethodMain P, ⌊0⌋, Normal)"
by blast
moreover with ‹(P, C0, Main) ⊢ ⇒(ClassMain P, MethodMain P, ⌊0⌋, Normal)›
‹PROG P ⊢ C0 sees Main: []→T = (mxs, mxl⇩0, is, xt) in D›
‹initParams = [λs. s Heap, λs. ⌊Value Null⌋]›
‹ek = λ(s, ret). True:(ClassMain P, MethodMain P, 0)↪⇘(D, Main)⇙initParams›
have "vp_snoc P C0 Main as (ClassMain P, MethodMain P, ⌊0⌋, Normal)
((λ(s, ret). True):(ClassMain P, MethodMain P, 0)↪⇘(D, Main)⇙[(λs. s Heap),(λs. ⌊Value Null⌋)])
(D, Main, None, Enter)"
by (fastforce intro: JVMCFG_reachable.Main_Call)
ultimately show ?case by blast
next
case (Main_Return_to_Exit P C0 Main)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (ClassMain P, MethodMain P, ⌊0⌋, nodeType.Return)"
by blast
moreover with ‹(P, C0, Main) ⊢ ⇒(ClassMain P, MethodMain P, ⌊0⌋, nodeType.Return)›
have "vp_snoc P C0 Main as (ClassMain P, MethodMain P, ⌊0⌋, nodeType.Return) ⇑id
(ClassMain P, MethodMain P, None, nodeType.Return)"
by (fastforce intro: JVMCFG_reachable.Main_Return_to_Exit)
ultimately show ?case by blast
next
case (Method_LFalse P C0 Main C M)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, None, Enter)"
by blast
moreover with ‹(P, C0, Main) ⊢ ⇒(C, M, None, Enter)›
have "vp_snoc P C0 Main as (C, M, None, Enter) (λs. False)⇩√ (C, M, None, Return)"
by (fastforce intro: JVMCFG_reachable.Method_LFalse)
ultimately show ?case by blast
next
case (Method_LTrue P C0 Main C M)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, None, Enter)"
by blast
moreover with ‹(P, C0, Main) ⊢ ⇒(C, M, None, Enter)›
have "vp_snoc P C0 Main as (C, M, None, Enter) (λs. True)⇩√ (C, M, ⌊0⌋, Enter)"
by (fastforce intro: JVMCFG_reachable.Method_LTrue)
ultimately show ?case by blast
next
case (CFG_Load C P C0 Main M pc n ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Enter)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter)›
‹instrs_of (PROG P) C M ! pc = Load n›
‹ek = ⇑λs. s(Stack (stkLength (P, C, M) pc) := s (Local n))›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Enter) ek (C, M, ⌊Suc pc⌋, Enter)"
by (fastforce intro: JVMCFG_reachable.CFG_Load)
ultimately show ?case by blast
next
case (CFG_Store C P C0 Main M pc n ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Enter)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter)›
‹instrs_of (PROG P) C M ! pc = Store n›
‹ek = ⇑λs. s(Local n := s (Stack (stkLength (P, C, M) pc - 1)))›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Enter) ek (C, M, ⌊Suc pc⌋, Enter)"
by (fastforce intro: JVMCFG_reachable.CFG_Store)
ultimately show ?case by blast
next
case (CFG_Push C P C0 Main M pc v ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Enter)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter)›
‹instrs_of (PROG P) C M ! pc = Push v›
‹ek = ⇑λs. s(Stack (stkLength (P, C, M) pc) ↦ Value v)›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Enter) ek (C, M, ⌊Suc pc⌋, Enter)"
by (fastforce intro: JVMCFG_reachable.CFG_Push)
ultimately show ?case by blast
next
case (CFG_Pop C P C0 Main M pc ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Enter)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter)›
‹instrs_of (PROG P) C M ! pc = Pop› ‹ek = ⇑id›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Enter) ek (C, M, ⌊Suc pc⌋, Enter)"
by (fastforce intro: JVMCFG_reachable.CFG_Pop)
ultimately show ?case by blast
next
case (CFG_IAdd C P C0 Main M pc ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Enter)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter)›
‹instrs_of (PROG P) C M ! pc = IAdd›
‹ek = ⇑λs. let i1 = the_Intg (stkAt s (stkLength (P, C, M) pc - 1));
i2 = the_Intg (stkAt s (stkLength (P, C, M) pc - 2))
in s(Stack (stkLength (P, C, M) pc - 2) ↦ Value (Intg (i1 + i2)))›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Enter) ek (C, M, ⌊Suc pc⌋, Enter)"
by (fastforce intro: JVMCFG_reachable.CFG_IAdd)
ultimately show ?case by blast
next
case (CFG_Goto C P C0 Main M pc i)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Enter)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter)›
‹instrs_of (PROG P) C M ! pc = Goto i›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Enter) (λs. True)⇩√ (C, M, ⌊nat (int pc + i)⌋, Enter)"
by (fastforce intro: JVMCFG_reachable.CFG_Goto)
ultimately show ?case by blast
next
case (CFG_CmpEq C P C0 Main M pc ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Enter)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter)›
‹instrs_of (PROG P) C M ! pc = CmpEq›
‹ek = ⇑λs. let e1 = stkAt s (stkLength (P, C, M) pc - 1);
e2 = stkAt s (stkLength (P, C, M) pc - 2)
in s(Stack (stkLength (P, C, M) pc - 2) ↦ Value (Bool (e1 = e2)))›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Enter) ek (C, M, ⌊Suc pc⌋, Enter)"
by (fastforce intro: JVMCFG_reachable.CFG_CmpEq)
ultimately show ?case by blast
next
case (CFG_IfFalse_False C P C0 Main M pc i ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Enter)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter)›
‹instrs_of (PROG P) C M ! pc = IfFalse i› ‹i ≠ 1›
‹ek = (λs. stkAt s (stkLength (P, C, M) pc - 1) = Bool False)⇩√›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Enter) ek (C, M, ⌊nat (int pc + i)⌋, Enter)"
by (fastforce intro: JVMCFG_reachable.CFG_IfFalse_False)
ultimately show ?case by blast
next
case (CFG_IfFalse_True C P C0 Main M pc i ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Enter)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter)›
‹instrs_of (PROG P) C M ! pc = IfFalse i›
‹ek = (λs. stkAt s (stkLength (P, C, M) pc - 1) ≠ Bool False ∨ i = 1)⇩√›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Enter) ek (C, M, ⌊Suc pc⌋, Enter)"
by (fastforce intro: JVMCFG_reachable.CFG_IfFalse_True)
ultimately show ?case by blast
next
case (CFG_New_Check_Normal C P C0 Main M pc Cl ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Enter)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter)›
‹instrs_of (PROG P) C M ! pc = New Cl› ‹ek = (λs. new_Addr (heap_of s) ≠ None)⇩√›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Enter) ek (C, M, ⌊pc⌋, Normal)"
by (fastforce intro: JVMCFG_reachable.CFG_New_Check_Normal)
ultimately show ?case by blast
next
case (CFG_New_Check_Exceptional C P C0 Main M pc Cl pc' ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Enter)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter)›
‹ instrs_of (PROG P) C M ! pc = New Cl›
‹pc' = (case match_ex_table (PROG P) OutOfMemory pc (ex_table_of (PROG P) C M) of None ⇒ None
| ⌊(pc'', d)⌋ ⇒ ⌊pc''⌋)› ‹ek = (λs. new_Addr (heap_of s) = None)⇩√›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Enter) ek (C, M, ⌊pc⌋, Exceptional pc' Enter)"
by (fastforce intro: JVMCFG_reachable.CFG_New_Check_Exceptional)
ultimately show ?case by blast
next
case (CFG_New_Update C P C0 Main M pc Cl ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Normal)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Normal)›
‹ instrs_of (PROG P) C M ! pc = New Cl›
‹ ek = ⇑λs. let a = the (new_Addr (heap_of s)) in
s(Heap ↦ Hp (heap_of s(a ↦ blank (PROG P) Cl)),
Stack (stkLength (P, C, M) pc) ↦ Value (Addr a))›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Normal) ek (C, M, ⌊Suc pc⌋, Enter)"
by (fastforce intro: JVMCFG_reachable.CFG_New_Update)
ultimately show ?case by blast
next
case (CFG_New_Exceptional_prop C P C0 Main M pc Cl ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Exceptional None Enter)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional None Enter)›
‹instrs_of (PROG P) C M ! pc = New Cl›
‹ek = ⇑λs. s(Exception ↦ Value (Addr (addr_of_sys_xcpt OutOfMemory)))›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Exceptional None Enter) ek (C, M, None, Return)"
by (fastforce intro: JVMCFG_reachable.CFG_New_Exceptional_prop)
ultimately show ?case by blast
next
case (CFG_New_Exceptional_handle C P C0 Main M pc pc' Cl ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter)›
‹instrs_of (PROG P) C M ! pc = New Cl›
‹ek = ⇑λs. s(Exception := None)(Stack (stkLength (P, C, M) pc' - 1) ↦
Value (Addr (addr_of_sys_xcpt OutOfMemory)))›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter) ek (C, M, ⌊pc'⌋, Enter)"
by (fastforce intro: JVMCFG_reachable.CFG_New_Exceptional_handle)
ultimately show ?case by blast
next
case (CFG_Getfield_Check_Normal C P C0 Main M pc F Cl ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Enter)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter)›
‹instrs_of (PROG P) C M ! pc = Getfield F Cl›
‹ek = (λs. stkAt s (stkLength (P, C, M) pc - 1) ≠ Null)⇩√›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Enter) ek (C, M, ⌊pc⌋, Normal)"
by (fastforce intro: JVMCFG_reachable.CFG_Getfield_Check_Normal)
ultimately show ?case by blast
next
case (CFG_Getfield_Check_Exceptional C P C0 Main M pc F Cl pc' ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Enter)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter)›
‹instrs_of (PROG P) C M ! pc = Getfield F Cl›
‹pc' = (case match_ex_table (PROG P) NullPointer pc (ex_table_of (PROG P) C M) of None ⇒ None
| ⌊(pc'', d)⌋ ⇒ ⌊pc''⌋)› ‹ek = (λs. stkAt s (stkLength (P, C, M) pc - 1) = Null)⇩√›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Enter) ek (C, M, ⌊pc⌋, Exceptional pc' Enter)"
by (fastforce intro: JVMCFG_reachable.CFG_Getfield_Check_Exceptional)
ultimately show ?case by blast
next
case (CFG_Getfield_Update C P C0 Main M pc F Cl ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Normal)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Normal)›
‹instrs_of (PROG P) C M ! pc = Getfield F Cl›
‹ek = ⇑λs. let (D, fs) = the (heap_of s (the_Addr (stkAt s (stkLength (P, C, M) pc - 1))))
in s(Stack (stkLength (P, C, M) pc - 1) ↦ Value (the (fs (F, Cl))))›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Normal) ek (C, M, ⌊Suc pc⌋, Enter)"
by (fastforce intro: JVMCFG_reachable.CFG_Getfield_Update)
ultimately show ?case by blast
next
case (CFG_Getfield_Exceptional_prop C P C0 Main M pc F Cl ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Exceptional None Enter)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional None Enter)›
‹instrs_of (PROG P) C M ! pc = Getfield F Cl›
‹ek = ⇑λs. s(Exception ↦ Value (Addr (addr_of_sys_xcpt NullPointer)))›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Exceptional None Enter) ek (C, M, None, Return)"
by (fastforce intro: JVMCFG_reachable.CFG_Getfield_Exceptional_prop)
ultimately show ?case by blast
next
case (CFG_Getfield_Exceptional_handle C P C0 Main M pc pc' F Cl ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter)›
‹instrs_of (PROG P) C M ! pc = Getfield F Cl›
‹ek = ⇑λs. s(Exception := None)(Stack (stkLength (P, C, M) pc' - 1) ↦
Value (Addr (addr_of_sys_xcpt NullPointer)))›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter) ek (C, M, ⌊pc'⌋, Enter)"
by (fastforce intro: JVMCFG_reachable.CFG_Getfield_Exceptional_handle)
ultimately show ?case by blast
next
case (CFG_Putfield_Check_Normal C P C0 Main M pc F Cl ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Enter)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter)›
‹instrs_of (PROG P) C M ! pc = Putfield F Cl›
‹ek = (λs. stkAt s (stkLength (P, C, M) pc - 2) ≠ Null)⇩√›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Enter) ek (C, M, ⌊pc⌋, Normal)"
by (fastforce intro: JVMCFG_reachable.CFG_Putfield_Check_Normal)
ultimately show ?case by blast
next
case (CFG_Putfield_Check_Exceptional C P C0 Main M pc F Cl pc' ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Enter)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter)›
‹instrs_of (PROG P) C M ! pc = Putfield F Cl›
‹pc' = (case match_ex_table (PROG P) NullPointer pc (ex_table_of (PROG P) C M) of None ⇒ None
| ⌊(pc'', d)⌋ ⇒ ⌊pc''⌋)› ‹ek = (λs. stkAt s (stkLength (P, C, M) pc - 2) = Null)⇩√›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Enter) ek (C, M, ⌊pc⌋, Exceptional pc' Enter)"
by (fastforce intro: JVMCFG_reachable.CFG_Putfield_Check_Exceptional)
ultimately show ?case by blast
next
case (CFG_Putfield_Update C P C0 Main M pc F Cl ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Normal)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Normal)›
‹instrs_of (PROG P) C M ! pc = Putfield F Cl›
‹ek = ⇑λs. let v = stkAt s (stkLength (P, C, M) pc - 1);
r = stkAt s (stkLength (P, C, M) pc - 2);
a = the_Addr r; (D, fs) = the (heap_of s a); h' = heap_of s(a ↦ (D, fs((F, Cl) ↦ v)))
in s(Heap ↦ Hp h')›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Normal) ek (C, M, ⌊Suc pc⌋, Enter)"
by (fastforce intro: JVMCFG_reachable.CFG_Putfield_Update)
ultimately show ?case by blast
next
case (CFG_Putfield_Exceptional_prop C P C0 Main M pc F Cl ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Exceptional None Enter)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional None Enter)›
‹instrs_of (PROG P) C M ! pc = Putfield F Cl›
‹ek = ⇑λs. s(Exception ↦ Value (Addr (addr_of_sys_xcpt NullPointer)))›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Exceptional None Enter) ek (C, M, None, Return)"
by (fastforce intro: JVMCFG_reachable.CFG_Putfield_Exceptional_prop)
ultimately show ?case by blast
next
case (CFG_Putfield_Exceptional_handle C P C0 Main M pc pc' F Cl ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter)›
‹instrs_of (PROG P) C M ! pc = Putfield F Cl›
‹ek = ⇑λs. s(Exception := None)(Stack (stkLength (P, C, M) pc' - 1) ↦
Value (Addr (addr_of_sys_xcpt NullPointer)))›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter) ek (C, M, ⌊pc'⌋, Enter)"
by (fastforce intro: JVMCFG_reachable.CFG_Putfield_Exceptional_handle)
ultimately show ?case by blast
next
case (CFG_Checkcast_Check_Normal C P C0 Main M pc Cl ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Enter)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter)›
‹instrs_of (PROG P) C M ! pc = Checkcast Cl›
‹ek = (λs. cast_ok (PROG P) Cl (heap_of s) (stkAt s (stkLength (P, C, M) pc - 1)))⇩√›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Enter) ek (C, M, ⌊Suc pc⌋, Enter)"
by (fastforce intro: JVMCFG_reachable.CFG_Checkcast_Check_Normal)
ultimately show ?case by blast
next
case (CFG_Checkcast_Check_Exceptional C P C0 Main M pc Cl pc' ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Enter)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter)›
‹instrs_of (PROG P) C M ! pc = Checkcast Cl›
‹pc' = (case match_ex_table (PROG P) ClassCast pc (ex_table_of (PROG P) C M) of None ⇒ None
| ⌊(pc'', d)⌋ ⇒ ⌊pc''⌋)›
‹ek = (λs. ¬ cast_ok (PROG P) Cl (heap_of s) (stkAt s (stkLength (P, C, M) pc - 1)))⇩√›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Enter) ek (C, M, ⌊pc⌋, Exceptional pc' Enter)"
by (fastforce intro: JVMCFG_reachable.CFG_Checkcast_Check_Exceptional)
ultimately show ?case by blast
next
case (CFG_Checkcast_Exceptional_prop C P C0 Main M pc Cl ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Exceptional None Enter)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional None Enter)›
‹instrs_of (PROG P) C M ! pc = Checkcast Cl›
‹ek = ⇑λs. s(Exception ↦ Value (Addr (addr_of_sys_xcpt ClassCast)))›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Exceptional None Enter) ek (C, M, None, Return)"
by (fastforce intro: JVMCFG_reachable.CFG_Checkcast_Exceptional_prop)
ultimately show ?case by blast
next
case (CFG_Checkcast_Exceptional_handle C P C0 Main M pc pc' Cl ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter)›
‹instrs_of (PROG P) C M ! pc = Checkcast Cl›
‹ek = ⇑λs. s(Exception := None)(Stack (stkLength (P, C, M) pc' - 1) ↦
Value (Addr (addr_of_sys_xcpt ClassCast)))›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter) ek (C, M, ⌊pc'⌋, Enter)"
by (fastforce intro: JVMCFG_reachable.CFG_Checkcast_Exceptional_handle)
ultimately show ?case by blast
next
case (CFG_Throw_Check C P C0 Main M pc pc' Exc d ek)
then obtain as where path_src: "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Enter)"
by blast
from ‹pc' = None ∨ match_ex_table (PROG P) Exc pc (ex_table_of (PROG P) C M) = ⌊(the pc', d)⌋›
show ?case
proof (elim disjE_strong)
assume "pc' = None"
with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter)›
‹instrs_of (PROG P) C M ! pc = Throw›
‹ek = (λs. let v = stkAt s (stkLength (P, C, M) pc - 1);
Cl = if v = Null then NullPointer else cname_of (heap_of s) (the_Addr v)
in case pc' of None ⇒ match_ex_table (PROG P) Cl pc (ex_table_of (PROG P) C M) = None
| ⌊pc''⌋ ⇒
∃d. match_ex_table (PROG P) Cl pc (ex_table_of (PROG P) C M) = ⌊(pc'', d)⌋)⇩√›
have "(P, C0, Main) ⊢ (C, M, ⌊pc⌋, Enter) -
(λs. (stkAt s (stkLength (P, C, M) pc - Suc 0) = Null ⟶
match_ex_table (PROG P) NullPointer pc (ex_table_of (PROG P) C M) = None) ∧
(stkAt s (stkLength (P, C, M) pc - Suc 0) ≠ Null ⟶
match_ex_table (PROG P) (cname_of (heap_of s)
(the_Addr (stkAt s (stkLength (P, C, M) pc - Suc 0)))) pc (ex_table_of (PROG P) C M) =
None))⇩√→ (C, M, ⌊pc⌋, Exceptional None Enter)"
by -(erule JVMCFG_reachable.CFG_Throw_Check, simp_all)
with path_src ‹pc' = None› ‹ek = (λs. let v = stkAt s (stkLength (P, C, M) pc - 1);
Cl = if v = Null then NullPointer else cname_of (heap_of s) (the_Addr v)
in case pc' of None ⇒ match_ex_table (PROG P) Cl pc (ex_table_of (PROG P) C M) = None
| ⌊pc''⌋ ⇒
∃d. match_ex_table (PROG P) Cl pc (ex_table_of (PROG P) C M) = ⌊(pc'', d)⌋)⇩√›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Enter) ek (C, M, ⌊pc⌋, Exceptional None Enter)"
by (fastforce intro: JVMCFG_reachable.CFG_Throw_Check)
with path_src ‹pc' = None› show ?thesis by blast
next
assume met: "match_ex_table (PROG P) Exc pc (ex_table_of (PROG P) C M) = ⌊(the pc', d)⌋"
and pc': "pc' ≠ None"
with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter)›
‹instrs_of (PROG P) C M ! pc = Throw›
‹ek = (λs. let v = stkAt s (stkLength (P, C, M) pc - 1);
Cl = if v = Null then NullPointer else cname_of (heap_of s) (the_Addr v)
in case pc' of None ⇒ match_ex_table (PROG P) Cl pc (ex_table_of (PROG P) C M) = None
| ⌊pc''⌋ ⇒
∃d. match_ex_table (PROG P) Cl pc (ex_table_of (PROG P) C M) = ⌊(pc'', d)⌋)⇩√›
have "(P, C0, Main) ⊢ (C, M, ⌊pc⌋, Enter) -
(λs. (stkAt s (stkLength (P, C, M) pc - Suc 0) = Null ⟶
(∃d. match_ex_table (PROG P) NullPointer pc
(ex_table_of (PROG P) C M) =
⌊(the pc', d)⌋)) ∧
(stkAt s (stkLength (P, C, M) pc - Suc 0) ≠ Null ⟶
(∃d. match_ex_table (PROG P)
(cname_of (heap_of s)
(the_Addr
(stkAt s (stkLength (P, C, M) pc - Suc 0))))
pc (ex_table_of (PROG P) C M) =
⌊(the pc', d)⌋)))⇩√→
(C, M, ⌊pc⌋, Exceptional ⌊the pc'⌋ Enter)"
by -(rule JVMCFG_reachable.CFG_Throw_Check, simp_all)
with met pc' path_src ‹ek = (λs. let v = stkAt s (stkLength (P, C, M) pc - 1);
Cl = if v = Null then NullPointer else cname_of (heap_of s) (the_Addr v)
in case pc' of None ⇒ match_ex_table (PROG P) Cl pc (ex_table_of (PROG P) C M) = None
| ⌊pc''⌋ ⇒
∃d. match_ex_table (PROG P) Cl pc (ex_table_of (PROG P) C M) = ⌊(pc'', d)⌋)⇩√›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Enter) ek (C, M, ⌊pc⌋, Exceptional pc' Enter)"
by (fastforce intro: JVMCFG_reachable.CFG_Throw_Check)
with path_src show ?thesis by blast
qed
next
case (CFG_Throw_prop C P C0 Main M pc ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Exceptional None Enter)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional None Enter)›
‹instrs_of (PROG P) C M ! pc = Throw›
‹ek = ⇑λs. s(Exception ↦ Value (stkAt s (stkLength (P, C, M) pc - 1)))›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Exceptional None Enter) ek (C, M, None, nodeType.Return)"
by (fastforce intro: JVMCFG_reachable.CFG_Throw_prop)
ultimately show ?case by blast
next
case (CFG_Throw_handle C P C0 Main M pc pc' ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter)›
‹pc' ≠ length (instrs_of (PROG P) C M)› ‹instrs_of (PROG P) C M ! pc = Throw›
‹ek = ⇑λs. s(Exception := None)(Stack (stkLength (P, C, M) pc' - 1) ↦
Value (stkAt s (stkLength (P, C, M) pc - 1)))›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter) ek (C, M, ⌊pc'⌋, Enter)"
by (fastforce intro: JVMCFG_reachable.CFG_Throw_handle)
ultimately show ?case by blast
next
case (CFG_Invoke_Check_NP_Normal C P C0 Main M pc M' n ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Enter)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter)›
‹instrs_of (PROG P) C M ! pc = Invoke M' n›
‹ek = (λs. stkAt s (stkLength (P, C, M) pc - Suc n) ≠ Null)⇩√›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Enter) ek (C, M, ⌊pc⌋, Normal)"
by (fastforce intro: JVMCFG_reachable.CFG_Invoke_Check_NP_Normal)
ultimately show ?case by blast
next
case (CFG_Invoke_Check_NP_Exceptional C P C0 Main M pc M' n pc' ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Enter)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter)›
‹instrs_of (PROG P) C M ! pc = Invoke M' n›
‹pc' = (case match_ex_table (PROG P) NullPointer pc (ex_table_of (PROG P) C M) of None ⇒ None
| ⌊(pc'', d)⌋ ⇒ ⌊pc''⌋)›
‹ek = (λs. stkAt s (stkLength (P, C, M) pc - Suc n) = Null)⇩√›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Enter) ek (C, M, ⌊pc⌋, Exceptional pc' Enter)"
by (fastforce intro: JVMCFG_reachable.CFG_Invoke_Check_NP_Exceptional)
ultimately show ?case by blast
next
case (CFG_Invoke_NP_prop C P C0 Main M pc M' n ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Exceptional None Enter)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional None Enter)›
‹instrs_of (PROG P) C M ! pc = Invoke M' n›
‹ek = ⇑λs. s(Exception ↦ Value (Addr (addr_of_sys_xcpt NullPointer)))›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Exceptional None Enter) ek (C, M, None, Return)"
by (fastforce intro: JVMCFG_reachable.CFG_Invoke_NP_prop)
ultimately show ?case by blast
next
case (CFG_Invoke_NP_handle C P C0 Main M pc pc' M' n ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter)›
‹instrs_of (PROG P) C M ! pc = Invoke M' n›
‹ek = ⇑λs. s(Exception := None)(Stack (stkLength (P, C, M) pc' - 1) ↦
Value (Addr (addr_of_sys_xcpt NullPointer)))›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Enter) ek (C, M, ⌊pc'⌋, Enter)"
by (fastforce intro: JVMCFG_reachable.CFG_Invoke_NP_handle)
ultimately show ?case by blast
next
case (CFG_Invoke_Call C P C0 Main M pc M' n ST LT D' Ts T mxs mxl⇩0 "is" xt D Q paramDefs ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Normal)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Normal)›
‹instrs_of (PROG P) C M ! pc = Invoke M' n› ‹TYPING P C M ! pc = ⌊(ST, LT)⌋›
‹ST ! n = Class D'› ‹PROG P ⊢ D' sees M': Ts→T = (mxs, mxl⇩0, is, xt) in D›
‹Q = (λ(s, ret). let r = stkAt s (stkLength (P, C, M) pc - Suc n);
C' = cname_of (heap_of s) (the_Addr r) in D = fst (method (PROG P) C' M'))›
‹paramDefs = (λs. s Heap) # (λs. s (Stack (stkLength (P, C, M) pc - Suc n))) #
rev (map (λi s. s (Stack (stkLength (P, C, M) pc - Suc i))) [0..<n])›
‹ek = Q:(C, M, pc)↪⇘(D, M')⇙paramDefs›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Normal) ek (D, M', None, Enter)"
by (fastforce intro: JVMCFG_reachable.CFG_Invoke_Call)
ultimately show ?case by blast
next
case (CFG_Invoke_False C P C0 Main M pc M' n ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Normal)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Normal)›
‹instrs_of (PROG P) C M ! pc = Invoke M' n› ‹ek = (λs. False)⇩√›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Normal) ek (C, M, ⌊pc⌋, Return)"
by (fastforce intro: JVMCFG_reachable.CFG_Invoke_False)
ultimately show ?case by blast
next
case (CFG_Invoke_Return_Check_Normal C P C0 Main M pc M' n ST LT ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, nodeType.Return)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, nodeType.Return)›
‹instrs_of (PROG P) C M ! pc = Invoke M' n› ‹TYPING P C M ! pc = ⌊(ST, LT)⌋›
‹ST ! n ≠ NT› ‹ek = (λs. s Exception = None)⇩√›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Return) ek (C, M, ⌊Suc pc⌋, Enter)"
by (fastforce intro: JVMCFG_reachable.CFG_Invoke_Return_Check_Normal)
ultimately show ?case by blast
next
case (CFG_Invoke_Return_Check_Exceptional C P C0 Main M pc M' n Exc pc' diff ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, nodeType.Return)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, nodeType.Return)›
‹instrs_of (PROG P) C M ! pc = Invoke M' n›
‹match_ex_table (PROG P) Exc pc (ex_table_of (PROG P) C M) = ⌊(pc', diff)⌋›
‹pc' ≠ length (instrs_of (PROG P) C M)›
‹ek = (λs. ∃v d. s Exception = ⌊v⌋ ∧
match_ex_table (PROG P) (cname_of (heap_of s) (the_Addr (the_Value v))) pc
(ex_table_of (PROG P) C M) = ⌊(pc', d)⌋)⇩√›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Return) ek (C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Return)"
by (fastforce intro: JVMCFG_reachable.CFG_Invoke_Return_Check_Exceptional)
ultimately show ?case by blast
next
case (CFG_Invoke_Return_Exceptional_handle C P C0 Main M pc pc' M' n ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ nodeType.Return)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ nodeType.Return)›
‹instrs_of (PROG P) C M ! pc = Invoke M' n›
‹ek = ⇑λs. s(Exception := None, Stack (stkLength (P, C, M) pc' - 1) := s Exception)›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Exceptional ⌊pc'⌋ Return) ek (C, M, ⌊pc'⌋, Enter)"
by (fastforce intro: JVMCFG_reachable.CFG_Invoke_Return_Exceptional_handle)
ultimately show ?case by blast
next
case (CFG_Invoke_Return_Exceptional_prop C P C0 Main M pc M' n ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, nodeType.Return)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, nodeType.Return)›
‹instrs_of (PROG P) C M ! pc = Invoke M' n›
‹ek = (λs. ∃v. s Exception = ⌊v⌋ ∧
match_ex_table (PROG P) (cname_of (heap_of s) (the_Addr (the_Value v))) pc
(ex_table_of (PROG P) C M) = None)⇩√›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Return) ek (C, M, None, Return)"
by (fastforce intro: JVMCFG_reachable.CFG_Invoke_Return_Exceptional_prop)
ultimately show ?case by blast
next
case (CFG_Return C P C0 Main M pc ek)
then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C, M, ⌊pc⌋, Enter)"
by blast
moreover with ‹C ≠ ClassMain P› ‹(P, C0, Main) ⊢ ⇒(C, M, ⌊pc⌋, Enter)›
‹instrs_of (PROG P) C M ! pc = instr.Return›
‹ek = ⇑λs. s(Stack 0 := s (Stack (stkLength (P, C, M) pc - 1)))›
have "vp_snoc P C0 Main as (C, M, ⌊pc⌋, Enter) ek (C, M, None, Return)"
by (fastforce intro: JVMCFG_reachable.CFG_Return)
ultimately show ?case by blast
next
case (CFG_Return_from_Method P C0 Main C M C' M' pc' Q' ps Q stateUpdate ek)
from ‹(P, C0, Main) ⊢ (C', M', ⌊pc'⌋, Normal) -Q':(C', M', pc')↪⇘(C, M)⇙ps→ (C, M, None, Enter)›
show ?case
proof cases
case Main_Call
with CFG_Return_from_Method obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (ClassMain P, MethodMain P, ⌊0⌋, Normal)"
by blast
moreover with Main_Call have "vp_snoc P C0 Main as (ClassMain P, MethodMain P, ⌊0⌋, Normal)
(λs. False)⇩√ (ClassMain P, MethodMain P, ⌊0⌋, Return)"
by (fastforce intro: Main_Call_LFalse)
ultimately show ?thesis using Main_Call CFG_Return_from_Method by blast
next
case CFG_Invoke_Call
with CFG_Return_from_Method obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
(ClassMain P, MethodMain P, None, Enter) as (C', M', ⌊pc'⌋, Normal)"
by blast
moreover with CFG_Invoke_Call
have "vp_snoc P C0 Main as (C', M', ⌊pc'⌋, Normal) (λs. False)⇩√ (C', M', ⌊pc'⌋, Return)"
by (fastforce intro: CFG_Invoke_False)
ultimately show ?thesis using CFG_Invoke_Call CFG_Return_from_Method by blast
qed
qed
declare JVMCFG_Interpret.vp_snocI []
declare JVMCFG_Interpret.valid_node_def [simp del]
valid_edge_def [simp del]
JVMCFG_Interpret.intra_path_def [simp del]
definition EP :: jvm_prog
where "EP = (''C'', Object, [],
[(''M'', [], Void, 1::nat, 0::nat, [Push Unit, instr.Return], [])]) # SystemClasses"
definition Phi_EP :: ty⇩P
where "Phi_EP C M = (if C = ''C'' ∧ M = ''M''
then [⌊([],[OK (Class ''C'')])⌋,⌊([Void],[OK (Class ''C'')])⌋] else [])"
lemma distinct_classes'':
"''C'' ≠ Object"
"''C'' ≠ NullPointer"
"''C'' ≠ OutOfMemory"
"''C'' ≠ ClassCast"
by (simp_all add: Object_def NullPointer_def OutOfMemory_def ClassCast_def)
lemmas distinct_classes =
distinct_classes distinct_classes'' distinct_classes'' [symmetric]
declare distinct_classes [simp add]
lemma i_max_2D: "i < Suc (Suc 0) ⟹ i = 0 ∨ i = 1" by auto
lemma EP_wf: "wf_jvm_prog⇘Phi_EP⇙ EP"
unfolding wf_jvm_prog_phi_def wf_prog_def
proof
show "wf_syscls EP"
by (simp add: EP_def wf_syscls_def SystemClasses_def sys_xcpts_def
ObjectC_def NullPointerC_def OutOfMemoryC_def ClassCastC_def)
next
have distinct_EP: "distinct_fst EP"
by (auto simp: EP_def SystemClasses_def ObjectC_def NullPointerC_def OutOfMemoryC_def
ClassCastC_def)
moreover have classes_wf:
"∀c∈set EP. wf_cdecl
(λP C (M, Ts, T⇩r, mxs, mxl⇩0, is, xt). wt_method P C Ts T⇩r mxs mxl⇩0 is xt (Phi_EP C M)) EP c"
proof
fix C
assume C_in_EP: "C ∈ set EP"
show "wf_cdecl
(λP C (M, Ts, T⇩r, mxs, mxl⇩0, is, xt). wt_method P C Ts T⇩r mxs mxl⇩0 is xt (Phi_EP C M)) EP C"
proof (cases "C ∈ set SystemClasses")
case True
thus ?thesis
by (auto simp: wf_cdecl_def SystemClasses_def ObjectC_def NullPointerC_def
OutOfMemoryC_def ClassCastC_def EP_def class_def)
next
case False
with C_in_EP have "C = (''C'', the (class EP ''C''))"
by (auto simp: EP_def SystemClasses_def class_def)
thus ?thesis
by (auto dest!: i_max_2D elim: Methods.cases
simp: wf_cdecl_def class_def EP_def wf_mdecl_def wt_method_def Phi_EP_def
wt_start_def check_types_def states_def JVM_SemiType.sl_def SystemClasses_def
stk_esl_def upto_esl_def loc_sl_def SemiType.esl_def ObjectC_def
SemiType.sup_def Err.sl_def Err.le_def err_def Listn.sl_def Method_def
Err.esl_def Opt.esl_def Product.esl_def relevant_entries_def)
qed
qed
ultimately show "(∀c∈set EP. wf_cdecl
(λP C (M, Ts, T⇩r, mxs, mxl⇩0, is, xt). wt_method P C Ts T⇩r mxs mxl⇩0 is xt (Phi_EP C M)) EP c) ∧
distinct_fst EP"
by simp
qed
lemma [simp]: "PROG (Abs_wf_jvmprog (EP, Phi_EP)) = EP"
proof (cases "(EP, Phi_EP) ∈ wf_jvmprog")
case True thus ?thesis by (simp add: Abs_wf_jvmprog_inverse)
next
case False with EP_wf show ?thesis by (simp add: wf_jvmprog_def)
qed
lemma [simp]: "TYPING (Abs_wf_jvmprog (EP, Phi_EP)) = Phi_EP"
proof (cases "(EP, Phi_EP) ∈ wf_jvmprog")
case True thus ?thesis by (simp add: Abs_wf_jvmprog_inverse)
next
case False with EP_wf show ?thesis by (simp add: wf_jvmprog_def)
qed
lemma method_in_EP_is_M:
"EP ⊢ C sees M: Ts→T = (mxs, mxl, is, xt) in D
⟹ C = ''C'' ∧ M = ''M'' ∧ Ts = [] ∧ T = Void ∧ mxs = 1 ∧ mxl = 0 ∧
is = [Push Unit, instr.Return] ∧ xt = [] ∧ D = ''C''"
by (fastforce elim: Methods.cases
simp: class_def SystemClasses_def ObjectC_def NullPointerC_def OutOfMemoryC_def ClassCastC_def
if_split_eq1 EP_def Method_def)
lemma [simp]:
"∃T Ts mxs mxl is. (∃xt. EP ⊢ ''C'' sees ''M'': Ts→T = (mxs, mxl, is, xt) in ''C'') ∧ is ≠ []"
using EP_wf
by (fastforce dest: mdecl_visible simp: wf_jvm_prog_phi_def EP_def)
lemma [simp]:
"∃T Ts mxs mxl is. (∃xt. EP ⊢ ''C'' sees ''M'': Ts→T = (mxs, mxl, is, xt) in ''C'') ∧
Suc 0 < length is"
using EP_wf
by (fastforce dest: mdecl_visible simp: wf_jvm_prog_phi_def EP_def)
lemma C_sees_M_in_EP [simp]:
"EP ⊢ ''C'' sees ''M'': []→Void = (Suc 0, 0, [Push Unit, instr.Return], []) in ''C''"
proof -
have "EP ⊢ ''C'' sees_methods [''M'' ↦ (([], Void, 1, 0, [Push Unit, instr.Return], []), ''C'')]"
by (fastforce intro: Methods.intros simp: class_def SystemClasses_def ObjectC_def EP_def)
thus ?thesis by (fastforce simp: Method_def)
qed
lemma instrs_of_EP_C_M [simp]:
"instrs_of EP ''C'' ''M'' = [Push Unit, instr.Return]"
unfolding method_def
by (rule theI2 [where P = "λ(D, Ts, T, m). EP ⊢ ''C'' sees ''M'': Ts→T = m in D"])
(auto dest: method_in_EP_is_M)
lemma ClassMain_not_C [simp]: "ClassMain (Abs_wf_jvmprog (EP, Phi_EP)) ≠ ''C''"
by (fastforce intro: no_Call_in_ClassMain [where P="Abs_wf_jvmprog (EP, Phi_EP)"] C_sees_M_in_EP)
lemma method_entry [dest!]: "(Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M'') ⊢ ⇒(C, M, None, Enter)
⟹ (C = ClassMain (Abs_wf_jvmprog (EP, Phi_EP)) ∧ M = MethodMain (Abs_wf_jvmprog (EP, Phi_EP)))
∨ (C = ''C'' ∧ M = ''M'')"
by (fastforce elim: reachable.cases elim!: JVMCFG.cases dest!: method_in_EP_is_M)
lemma valid_node_in_EP_D:
assumes vn: "JVMCFG_Interpret.valid_node (Abs_wf_jvmprog (EP, Phi_EP)) ''C'' ''M'' n"
shows "n ∈ {
(ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)), None, Enter),
(ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)), None, Return),
(ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)), ⌊0⌋, Enter),
(ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)), ⌊0⌋, Normal),
(ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)), ⌊0⌋, Return),
(''C'', ''M'', None, Enter),
(''C'', ''M'', ⌊0⌋, Enter),
(''C'', ''M'', ⌊1⌋, Enter),
(''C'', ''M'', None, Return)
}"
using vn
proof (cases rule: JVMCFG_Interpret.valid_node_cases')
let ?prog = "Abs_wf_jvmprog (EP, Phi_EP)"
case (Source e)
then obtain C M pc nt ek C' M' pc' nt'
where [simp]: "e = ((C, M, pc, nt), ek, (C', M', pc', nt'))"
and [simp]: "n = (C, M, pc, nt)"
and edge: "(?prog, ''C'', ''M'') ⊢ (C, M, pc, nt) -ek→ (C', M', pc', nt')"
by (cases e) (fastforce simp: valid_edge_def)
from edge have src_reachable: "(?prog, ''C'', ''M'') ⊢ ⇒(C, M, pc, nt)"
by -(drule sourcenode_reachable)
show ?thesis
proof (cases "C = ClassMain ?prog")
case True
with src_reachable have "M = MethodMain ?prog"
by (fastforce dest: ClassMain_imp_MethodMain)
with True edge show ?thesis
by clarsimp (erule JVMCFG.cases, simp_all)
next
case False
with src_reachable obtain T Ts mb where "EP ⊢ C sees M:Ts→T = mb in C"
by (fastforce dest: method_of_reachable_node_exists)
hence [simp]: "C = ''C''"
and [simp]: "M = ''M''"
and [simp]: "Ts = []"
and [simp]: "T = Void"
and [simp]: "mb = (1, 0, [Push Unit, instr.Return], [])"
by (cases mb, fastforce dest: method_in_EP_is_M)+
from src_reachable False have "pc ∈ {None, ⌊0⌋, ⌊1⌋}"
by (fastforce dest: instr_of_reachable_node_typable)
show ?thesis
proof (cases pc)
case None
with edge False show ?thesis
by clarsimp (erule JVMCFG.cases, simp_all)
next
case (Some pc')
show ?thesis
proof (cases pc')
case 0
with Some False edge show ?thesis
by clarsimp (erule JVMCFG.cases, fastforce+)
next
case (Suc n)
with ‹pc ∈ {None, ⌊0⌋, ⌊1⌋}› Some have "pc = ⌊1⌋"
by simp
with False edge show ?thesis
by clarsimp (erule JVMCFG.cases, fastforce+)
qed
qed
qed
next
let ?prog = "Abs_wf_jvmprog (EP, Phi_EP)"
case (Target e)
then obtain C M pc nt ek C' M' pc' nt'
where [simp]: "e = ((C, M, pc, nt), ek, (C', M', pc', nt'))"
and [simp]: "n = (C', M', pc', nt')"
and edge: "(?prog, ''C'', ''M'') ⊢ (C, M, pc, nt) -ek→ (C', M', pc', nt')"
by (cases e) (fastforce simp: valid_edge_def)
from edge have trg_reachable: "(?prog, ''C'', ''M'') ⊢ ⇒(C', M', pc', nt')"
by -(drule targetnode_reachable)
show ?thesis
proof (cases "C' = ClassMain ?prog")
case True
with trg_reachable have "M' = MethodMain ?prog"
by (fastforce dest: ClassMain_imp_MethodMain)
with True edge show ?thesis
by -(clarsimp, (erule JVMCFG.cases, simp_all))+
next
case False
with trg_reachable obtain T Ts mb where "EP ⊢ C' sees M':Ts→T = mb in C'"
by (fastforce dest: method_of_reachable_node_exists)
hence [simp]: "C' = ''C''"
and [simp]: "M' = ''M''"
and [simp]: "Ts = []"
and [simp]: "T = Void"
and [simp]: "mb = (1, 0, [Push Unit, instr.Return], [])"
by (cases mb, fastforce dest: method_in_EP_is_M)+
from trg_reachable False have "pc' ∈ {None, ⌊0⌋, ⌊1⌋}"
by (fastforce dest: instr_of_reachable_node_typable)
show ?thesis
proof (cases pc')
case None
with edge False show ?thesis
by clarsimp (erule JVMCFG.cases, simp_all)
next
case (Some pc'')
show ?thesis
proof (cases pc'')
case 0
with Some False edge show ?thesis
by -(clarsimp, (erule JVMCFG.cases, fastforce+))+
next
case (Suc n)
with ‹pc' ∈ {None, ⌊0⌋, ⌊1⌋}› Some have "pc' = ⌊1⌋"
by simp
with False edge show ?thesis
by -(clarsimp, (erule JVMCFG.cases, fastforce+))+
qed
qed
qed
qed
lemma Main_Entry_valid [simp]:
"JVMCFG_Interpret.valid_node (Abs_wf_jvmprog (EP, Phi_EP)) ''C'' ''M''
(ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)), None, Enter)"
proof -
have "valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M'')
((ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)), None,
Enter),
(λs. False)⇩√,
(ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)), None,
Return))"
by (auto simp: valid_edge_def intro: JVMCFG_reachable.intros)
thus ?thesis by (fastforce simp: JVMCFG_Interpret.valid_node_def)
qed
lemma main_0_Enter_reachable [simp]: "(P, C0, Main) ⊢ ⇒(ClassMain P, MethodMain P, ⌊0⌋, Enter)"
by (rule reachable_step [where n="(ClassMain P, MethodMain P, None, Enter)"])
(fastforce intro: JVMCFG_reachable.intros)+
lemma main_0_Normal_reachable [simp]: "(P, C0, Main) ⊢ ⇒(ClassMain P, MethodMain P, ⌊0⌋, Normal)"
by (rule reachable_step [where n="(ClassMain P, MethodMain P, ⌊0⌋, Enter)"], simp)
(fastforce intro: JVMCFG_reachable.intros)
lemma main_0_Return_reachable [simp]: "(P, C0, Main) ⊢ ⇒(ClassMain P, MethodMain P, ⌊0⌋, Return)"
by (rule reachable_step [where n="(ClassMain P, MethodMain P, ⌊0⌋, Normal)"], simp)
(fastforce intro: JVMCFG_reachable.intros)
lemma Exit_reachable [simp]: "(P, C0, Main) ⊢ ⇒(ClassMain P, MethodMain P, None, Return)"
by (rule reachable_step [where n="(ClassMain P, MethodMain P, ⌊0⌋, Return)"], simp)
(fastforce intro: JVMCFG_reachable.intros)
definition
"cfg_wf_prog =
{(P, C0, Main). (∀n. JVMCFG_Interpret.valid_node P C0 Main n ⟶
(∃as. CFG.valid_path' sourcenode targetnode kind (valid_edge (P, C0, Main))
(get_return_edges P) n as (ClassMain P, MethodMain P, None, Return)))}"
typedef cfg_wf_prog = cfg_wf_prog
unfolding cfg_wf_prog_def
proof
let ?prog = "(Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M'')"
let ?edge_main0 = "((ClassMain (fst ?prog), MethodMain (fst ?prog), None, Enter),
(λs. False)⇩√,
(ClassMain (fst ?prog), MethodMain (fst ?prog), None, Return))"
let ?edge_main1 = "((ClassMain (fst ?prog), MethodMain (fst ?prog), None, Enter),
(λs. True)⇩√,
(ClassMain (fst ?prog), MethodMain (fst ?prog), ⌊0⌋, Enter))"
let ?edge_main2 = "((ClassMain (fst ?prog), MethodMain (fst ?prog), ⌊0⌋, Enter),
⇑id,
(ClassMain (fst ?prog), MethodMain (fst ?prog), ⌊0⌋, Normal))"
let ?edge_main3 = "((ClassMain (fst ?prog), MethodMain (fst ?prog), ⌊0⌋, Normal),
(λs. False)⇩√,
(ClassMain (fst ?prog), MethodMain (fst ?prog), ⌊0⌋, Return))"
let ?edge_main4 = "((ClassMain (fst ?prog), MethodMain (fst ?prog), ⌊0⌋, Return),
⇑id,
(ClassMain (fst ?prog), MethodMain (fst ?prog), None, Return))"
let ?edge_call = "((ClassMain (fst ?prog), MethodMain (fst ?prog), ⌊0⌋, Normal),
((λ(s, ret). True):(ClassMain (fst ?prog),
MethodMain (fst ?prog), 0)↪⇘(''C'', ''M'')⇙[(λs. s Heap),(λs. ⌊Value Null⌋)]),
(''C'', ''M'', None, Enter))"
let ?edge_C0 = "((''C'', ''M'', None, Enter),
(λs. False)⇩√,
(''C'', ''M'', None, Return))"
let ?edge_C1 = "((''C'', ''M'', None, Enter),
(λs. True)⇩√,
(''C'', ''M'', ⌊0⌋, Enter))"
let ?edge_C2 = "((''C'', ''M'', ⌊0⌋, Enter),
⇑(λs. s(Stack 0 ↦ Value Unit)),
(''C'', ''M'', ⌊1⌋, Enter))"
let ?edge_C3 = "((''C'', ''M'', ⌊1⌋, Enter),
⇑(λs. s(Stack 0 := s (Stack 0))),
(''C'', ''M'', None, Return))"
let ?edge_return = "((''C'', ''M'', None, Return),
(λ(s, ret). ret = (ClassMain (fst ?prog),
MethodMain (fst ?prog), 0))↩⇘(''C'',''M'')⇙(λs s'. s'(Heap := s Heap,
Exception := s Exception,
Stack 0 := s (Stack 0))),
(ClassMain (fst ?prog), MethodMain (fst ?prog), ⌊0⌋, Return))"
have [simp]:
"(Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M'') ⊢ ⇒(''C'', ''M'', None, Enter)"
by (rule reachable_step [where n="(ClassMain (fst ?prog), MethodMain (fst ?prog), ⌊0⌋, Normal)"]
, simp)
(fastforce intro: Main_Call C_sees_M_in_EP)
hence [simp]:
"(Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M'') ⊢ ⇒(''C'', ''M'', None, nodeType.Return)"
by (rule reachable_step [where n="(''C'', ''M'', None, Enter)"])
(fastforce intro: JVMCFG_reachable.intros)
have [simp]:
"(Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M'') ⊢ ⇒(''C'', ''M'', ⌊0⌋, Enter)"
by (rule reachable_step [where n="(''C'', ''M'', None, Enter)"], simp)
(fastforce intro: JVMCFG_reachable.intros)
hence [simp]:
"(Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M'') ⊢ ⇒(''C'', ''M'', ⌊Suc 0⌋, Enter)"
by (fastforce intro: reachable_step [where n="(''C'', ''M'', ⌊0⌋, Enter)"] CFG_Push
simp: ClassMain_not_C [symmetric])
show "?prog ∈ {(P, C0, Main).
∀n. CFG.valid_node sourcenode targetnode (valid_edge (P, C0, Main)) n ⟶
(∃as. CFG.valid_path' sourcenode targetnode kind (valid_edge (P, C0, Main))
(get_return_edges P) n as
(ClassMain P, MethodMain P, None, nodeType.Return))}"
proof (auto dest!: valid_node_in_EP_D)
have "CFG.valid_path' sourcenode targetnode kind
(valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
(get_return_edges (Abs_wf_jvmprog (EP, Phi_EP)))
(ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
None, Enter)
[?edge_main0]
(ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
None, nodeType.Return)"
by (fastforce intro: JVMCFG_Interpret.intra_path_vp JVMCFG_reachable.intros
simp: JVMCFG_Interpret.intra_path_def intra_kind_def valid_edge_def)
thus " ∃as. CFG.valid_path' sourcenode targetnode kind
(valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
(get_return_edges (Abs_wf_jvmprog (EP, Phi_EP)))
(ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
None, Enter)
as (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
None, nodeType.Return)"
by blast
next
have "CFG.valid_path' sourcenode targetnode kind
(valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
(get_return_edges (Abs_wf_jvmprog (EP, Phi_EP)))
(ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
None, nodeType.Return)
[] (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
None, nodeType.Return)"
by (fastforce intro: JVMCFG_Interpret.intra_path_vp simp: JVMCFG_Interpret.intra_path_def)
thus "∃as. CFG.valid_path' sourcenode targetnode kind
(valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
(get_return_edges (Abs_wf_jvmprog (EP, Phi_EP)))
(ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
None, nodeType.Return)
as (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
None, nodeType.Return)"
by blast
next
have "CFG.valid_path' sourcenode targetnode kind
(valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
(get_return_edges (Abs_wf_jvmprog (EP, Phi_EP)))
(ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
⌊0⌋, Enter)
[?edge_main2, ?edge_main3, ?edge_main4]
(ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
None, nodeType.Return)"
by (fastforce intro: JVMCFG_Interpret.intra_path_vp JVMCFG_reachable.intros
simp: JVMCFG_Interpret.intra_path_def intra_kind_def valid_edge_def)
thus "∃as. CFG.valid_path' sourcenode targetnode kind
(valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
(get_return_edges (Abs_wf_jvmprog (EP, Phi_EP)))
(ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
⌊0⌋, Enter)
as (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
None, nodeType.Return)"
by blast
next
have "CFG.valid_path' sourcenode targetnode kind
(valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
(get_return_edges (Abs_wf_jvmprog (EP, Phi_EP)))
(ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
⌊0⌋, Normal)
[?edge_main3, ?edge_main4]
(ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
None, nodeType.Return)"
by (fastforce intro: JVMCFG_Interpret.intra_path_vp JVMCFG_reachable.intros
simp: JVMCFG_Interpret.intra_path_def intra_kind_def valid_edge_def)
thus "∃as. CFG.valid_path' sourcenode targetnode kind
(valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
(get_return_edges (Abs_wf_jvmprog (EP, Phi_EP)))
(ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
⌊0⌋, Normal)
as (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
None, nodeType.Return)"
by blast
next
have "CFG.valid_path' sourcenode targetnode kind
(valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
(get_return_edges (Abs_wf_jvmprog (EP, Phi_EP)))
(ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
⌊0⌋, nodeType.Return)
[?edge_main4]
(ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
None, nodeType.Return)"
by (fastforce intro: JVMCFG_Interpret.intra_path_vp JVMCFG_reachable.intros
simp: JVMCFG_Interpret.intra_path_def intra_kind_def valid_edge_def)
thus "∃as. CFG.valid_path' sourcenode targetnode kind
(valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
(get_return_edges (Abs_wf_jvmprog (EP, Phi_EP)))
(ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
⌊0⌋, nodeType.Return)
as (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
None, nodeType.Return)"
by blast
next
have "CFG.valid_path' sourcenode targetnode kind
(valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
(get_return_edges (Abs_wf_jvmprog (EP, Phi_EP))) (''C'', ''M'', None, Enter)
[?edge_C0, ?edge_return, ?edge_main4]
(ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
None, nodeType.Return)"
by (fastforce intro: JVMCFG_reachable.intros C_sees_M_in_EP
simp: JVMCFG_Interpret.vp_def valid_edge_def stkLength_def JVMCFG_Interpret.valid_path_def)
thus "∃as. CFG.valid_path' sourcenode targetnode kind
(valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
(get_return_edges (Abs_wf_jvmprog (EP, Phi_EP))) (''C'', ''M'', None, Enter) as
(ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
None, nodeType.Return)"
by blast
next
have "CFG.valid_path' sourcenode targetnode kind
(valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
(get_return_edges (Abs_wf_jvmprog (EP, Phi_EP))) (''C'', ''M'', ⌊0⌋, Enter)
[?edge_C2, ?edge_C3, ?edge_return, ?edge_main4]
(ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
None, nodeType.Return)"
by (fastforce intro: Main_Return_to_Exit CFG_Return_from_Method Main_Call
C_sees_M_in_EP CFG_Return CFG_Push
simp: JVMCFG_Interpret.vp_def valid_edge_def stkLength_def Phi_EP_def
ClassMain_not_C [symmetric] JVMCFG_Interpret.valid_path_def)
thus "∃as. CFG.valid_path' sourcenode targetnode kind
(valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
(get_return_edges (Abs_wf_jvmprog (EP, Phi_EP))) (''C'', ''M'', ⌊0⌋, Enter) as
(ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
None, nodeType.Return)"
by blast
next
have "CFG.valid_path' sourcenode targetnode kind
(valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
(get_return_edges (Abs_wf_jvmprog (EP, Phi_EP))) (''C'', ''M'', ⌊Suc 0⌋, Enter)
[?edge_C3, ?edge_return, ?edge_main4]
(ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
None, nodeType.Return)"
by (fastforce intro: JVMCFG_reachable.intros C_sees_M_in_EP
simp: JVMCFG_Interpret.vp_def valid_edge_def stkLength_def Phi_EP_def
ClassMain_not_C [symmetric] JVMCFG_Interpret.valid_path_def)
thus "∃as. CFG.valid_path' sourcenode targetnode kind
(valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
(get_return_edges (Abs_wf_jvmprog (EP, Phi_EP))) (''C'', ''M'', ⌊Suc 0⌋, Enter) as
(ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
None, nodeType.Return)"
by blast
next
have "CFG.valid_path' sourcenode targetnode kind
(valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
(get_return_edges (Abs_wf_jvmprog (EP, Phi_EP))) (''C'', ''M'', None, nodeType.Return)
[?edge_return, ?edge_main4]
(ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
None, nodeType.Return)"
by (fastforce intro: JVMCFG_reachable.intros C_sees_M_in_EP
simp: JVMCFG_Interpret.vp_def valid_edge_def JVMCFG_Interpret.valid_path_def stkLength_def)
thus "∃as. CFG.valid_path' sourcenode targetnode kind
(valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
(get_return_edges (Abs_wf_jvmprog (EP, Phi_EP))) (''C'', ''M'', None, nodeType.Return)
as (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
None, nodeType.Return)"
by blast
qed
qed
abbreviation lift_to_cfg_wf_prog :: "(jvm_method ⇒ 'a) ⇒ (cfg_wf_prog ⇒ 'a)"
("_⇘CFG⇙")
where "f⇘CFG⇙ ≡ (λP. f (Rep_cfg_wf_prog P))"
lemma valid_edge_CFG_def: "valid_edge⇘CFG⇙ P = valid_edge (fst⇘CFG⇙ P, fst (snd⇘CFG⇙ P), snd (snd⇘CFG⇙ P))"
by (cases P) (clarsimp simp: Abs_cfg_wf_prog_inverse)
interpretation JVMCFG_Postdomination:
Postdomination "sourcenode" "targetnode" "kind" "valid_edge⇘CFG⇙ P"
"(ClassMain (fst⇘CFG⇙ P), MethodMain (fst⇘CFG⇙ P), None, Enter)"
"(λ(C, M, pc, type). (C, M))" "get_return_edges (fst⇘CFG⇙ P)"
"((ClassMain (fst⇘CFG⇙ P), MethodMain (fst⇘CFG⇙ P)),[],[]) # procs (PROG (fst⇘CFG⇙ P))"
"(ClassMain (fst⇘CFG⇙ P), MethodMain (fst⇘CFG⇙ P))"
"(ClassMain (fst⇘CFG⇙ P), MethodMain (fst⇘CFG⇙ P), None, Return)"
for P
unfolding valid_edge_CFG_def
proof
fix n
obtain P' C0 Main where [simp]: "fst⇘CFG⇙ P = P'" and [simp]: "fst (snd⇘CFG⇙ P) = C0"
and [simp]: "snd (snd⇘CFG⇙ P) = Main"
by (cases P) clarsimp
assume "CFG.valid_node sourcenode targetnode
(valid_edge (fst⇘CFG⇙ P, fst (snd⇘CFG⇙ P), snd (snd⇘CFG⇙ P))) n"
thus "∃as. CFG.valid_path' sourcenode targetnode kind
(valid_edge (fst⇘CFG⇙ P, fst (snd⇘CFG⇙ P), snd (snd⇘CFG⇙ P)))
(get_return_edges (fst⇘CFG⇙ P))
(ClassMain (fst⇘CFG⇙ P), MethodMain (fst⇘CFG⇙ P), None, Enter) as n"
by (auto dest: sourcenode_reachable targetnode_reachable valid_Entry_path
simp: JVMCFG_Interpret.valid_node_def valid_edge_def)
next
fix n
obtain P' C0 Main where [simp]: "fst⇘CFG⇙ P = P'" and [simp]: "fst (snd⇘CFG⇙ P) = C0"
and [simp]: "snd (snd⇘CFG⇙ P) = Main"
and "(P', C0, Main) ∈ cfg_wf_prog"
by (cases P) (clarsimp simp: Abs_cfg_wf_prog_inverse)
assume "CFG.valid_node sourcenode targetnode
(valid_edge (fst⇘CFG⇙ P, fst (snd⇘CFG⇙ P), snd (snd⇘CFG⇙ P))) n"
with ‹(P', C0, Main) ∈ cfg_wf_prog›
show "∃as. CFG.valid_path' sourcenode targetnode kind
(valid_edge (fst⇘CFG⇙ P, fst (snd⇘CFG⇙ P), snd (snd⇘CFG⇙ P)))
(get_return_edges (fst⇘CFG⇙ P)) n as
(ClassMain (fst⇘CFG⇙ P), MethodMain (fst⇘CFG⇙ P), None, nodeType.Return)"
by (cases n) (fastforce simp: cfg_wf_prog_def)
next
fix n n'
obtain P' C0 Main where [simp]: "fst⇘CFG⇙ P = P'" and [simp]: "fst (snd⇘CFG⇙ P) = C0"
and [simp]: "snd (snd⇘CFG⇙ P) = Main"
by (cases P) clarsimp
assume "CFGExit.method_exit sourcenode kind
(valid_edge (fst⇘CFG⇙ P, fst (snd⇘CFG⇙ P), snd (snd⇘CFG⇙ P)))
(ClassMain (fst⇘CFG⇙ P), MethodMain (fst⇘CFG⇙ P), None, nodeType.Return) n"
and "CFGExit.method_exit sourcenode kind
(valid_edge (fst⇘CFG⇙ P, fst (snd⇘CFG⇙ P), snd (snd⇘CFG⇙ P)))
(ClassMain (fst⇘CFG⇙ P), MethodMain (fst⇘CFG⇙ P), None, nodeType.Return) n'"
and "(λ(C, M, pc, type). (C, M)) n = (λ(C, M, pc, type). (C, M)) n'"
thus "n = n'"
by (auto simp: JVMCFG_Exit_Interpret.method_exit_def valid_edge_def)
(fastforce elim: JVMCFG.cases)+
qed
end
Theory JVMSDG
theory JVMSDG imports JVMCFG_wf JVMPostdomination "../StaticInter/SDG" begin
interpretation JVMCFGExit_wf_new_type:
CFGExit_wf "sourcenode" "targetnode" "kind" "valid_edge⇘CFG⇙ P"
"(ClassMain (fst⇘CFG⇙ P), MethodMain (fst⇘CFG⇙ P), None, Enter)"
"(λ(C, M, pc, type). (C, M))" "get_return_edges (fst⇘CFG⇙ P)"
"((ClassMain (fst⇘CFG⇙ P), MethodMain (fst⇘CFG⇙ P)),[],[]) # procs (PROG (fst⇘CFG⇙ P))"
"(ClassMain (fst⇘CFG⇙ P), MethodMain (fst⇘CFG⇙ P))"
"(ClassMain (fst⇘CFG⇙ P), MethodMain (fst⇘CFG⇙ P), None, Return)"
"Def (fst⇘CFG⇙ P)" "Use (fst⇘CFG⇙ P)" "ParamDefs (fst⇘CFG⇙ P)" "ParamUses (fst⇘CFG⇙ P)"
for P
unfolding valid_edge_CFG_def
..
interpretation JVM_SDG :
SDG "sourcenode" "targetnode" "kind" "valid_edge⇘CFG⇙ P"
"(ClassMain (fst⇘CFG⇙ P), MethodMain (fst⇘CFG⇙ P), None, Enter)"
"(λ(C, M, pc, type). (C, M))" "get_return_edges (fst⇘CFG⇙ P)"
"((ClassMain (fst⇘CFG⇙ P), MethodMain (fst⇘CFG⇙ P)),[],[]) # procs (PROG (fst⇘CFG⇙ P))"
"(ClassMain (fst⇘CFG⇙ P), MethodMain (fst⇘CFG⇙ P))"
"(ClassMain (fst⇘CFG⇙ P), MethodMain (fst⇘CFG⇙ P), None, Return)"
"Def (fst⇘CFG⇙ P)" "Use (fst⇘CFG⇙ P)" "ParamDefs (fst⇘CFG⇙ P)" "ParamUses (fst⇘CFG⇙ P)"
for P
..
end